home *** CD-ROM | disk | FTP | other *** search
/ BBS Toolkit / BBS Toolkit.iso / rbbs_pc / mpl172b.zip / RBBSSUB3.BAS < prev    next >
BASIC Source File  |  1989-09-12  |  121KB  |  3,446 lines
  1. ' $linesize:132
  2. ' $title: 'RBBSSUB3.BAS CPC17.2B, Copyright 1986 - 89 by D. Thomas Mack'
  3. '  Copyright 1989 by D. Thomas Mack, all rights reserved.
  4. '  Name ...............: RBBSSUB3.BAS
  5. '  Written by .........: D. Thomas Mack
  6. '  First Released .....: May 28, 1989
  7. '  Subsequent Releases.: 05-28-89
  8. '  Copyright ..........: 1986 - 1989
  9. '  Purpose.............: The Remote Bulletin Board System for the IBM PC,
  10. '     RBBS-PC.BAS utilizes a lot of common subroutines.  Those that do not
  11. '     require error trapping are incorporated within RBBSSUB 2-5 as
  12. '     separately callable subroutines in order to free up as much
  13. '     code as possible within the 64K code segment used by RBBS-PC.BAS.
  14. '  Parameters..........: Most parameters are passed via a COMMON statement.
  15. '
  16. ' Subroutine  Line               Function of Subroutine
  17. '   Name     Number
  18. '  ALLCAPS    58060   Convert a string to all upper case characters
  19. '  AMORPM     41498   Calculate the current time as AM or PM
  20. '  ASKGRAPH   43004   Determine users graphic default
  21. '  BADFILE    20741   Check for system crash attempt with bad device name
  22. '  CARRIER    42000   Test for whether to continue in RBBS           ' KG080501
  23. '  CHECKRATIO 20096   Test upload/download ratio
  24. '  CHECKTIM   58070   Test to insure that users don't exceed their time
  25. '  CHKCARRIER 42005   Checks whether still have carrier              ' KG080501
  26. '  CHKNEWBUL  58110   Check for new bulletins based on their file creation date
  27. '  CHKTREMAIN 41008   Set up to log off if time exceeded
  28. '  COMMINFO   44020   Get users baud rate and parity in a string format
  29. '  CTLINES    58160   Count categories a file can be classified into
  30. '  CTNEWFILES 58150   Check for number of files uploaded after a specific date
  31. '  DELAYIT    50495   Wait number of seconds specified before returning
  32. '  DISPCALL   57001   Display callers file
  33. '  DISPLAYTR  41032   Compute and display time remaining
  34. '  DISUPDIR   58165   Display the shared directory of the FMS mng. sys.
  35. '  FILELOCK   21993   Allow files to be shared among multiple RBBS-PC's
  36. '  FINDFUNC   30595   Handle local keyboard's function & SYSOP's keys
  37. '  FINDLAST   58600   Finds last occurence of a string in a string
  38. '  FINDTIME   58050   Calculate the number of seconds since midnight
  39. '  GRAPHIC    43031   Determines whether graphic version of file exists
  40. '  HASHRBBS   58080   "Hash" to a user's record in the USERS file
  41. '  INITFMS    58162   Initialize the RBBS-PC's File Management System
  42. '  INITIBM    30000   Open/create NETBIOS semaphore file
  43. '  INSCOMMA   58130   Format commands in the command prompt
  44. '  LIBRARY    21105   Provide support for "library" drives
  45. '  LINESNFIL  58161   Counts lines in a file
  46. '  LOADNEW    58140   Find the latest uploads
  47. '  MODEMPUT   52070   Write a modem command string to the modem
  48. '  OPENMSG    30500   Open the messages file as file number 1
  49. '  PAGEUP     33202   Display user info. on local screen for SYSOP
  50. '  READPROF   44000   Read user's profile on return from a "door"
  51. '  SAVEPROF   43068   Save the user's provile when exiting to "doors" or DOS
  52. '  SENDNAME   20293   Send filename via EXEC-PC protocol during autodownload
  53. '  SETOPTS    58100   Set correct prompt line for each subsystem
  54. '  SRTSTRNG   58120   Sort characters in a string
  55. '  TESTUSER   20310   Check if user's software can do auto downloading
  56. '  TIMEREMAIN 41010   Compute time remaining in minutes
  57. '  UPDTUPLOAD 20705   Updates upload directory file
  58. '  WILDFILE   20290   Determines whether string matches a pattern
  59. '  XFERTYPE   21600   Identify the file transfer protocol
  60. '
  61. '  $INCLUDE: 'RBBS-VAR.BAS'
  62. '
  63. 20290 ' $SUBTITLE: 'WILDFILE -- Matches file to a filespec'
  64. ' $PAGE
  65. '  NAME    -- WILDFILE
  66. '
  67. '  INPUTS  -- PARAMETER             MEANING
  68. '             PATTERN$           PATTERN TO CHECK AGAINST
  69. '             ITEM.TO.MATCH$     FILE NAME TO MATCH
  70. '
  71. '  OUTPUTS -- DOES.MATCH         WHETHER MATCHES
  72. '
  73. '  PURPOSE  Determine whether a file name is an instance of
  74. '    a file specification.  Exactly like DOS except that ? must have a
  75. '    character.
  76. '
  77.       SUB WILDFILE (PATTERN$,ITEM.TO.MATCH$,DOES.MATCH) STATIC
  78.       IF PATTERN$ <> PREV.PATTERN$ THEN _
  79.          CALL BRKFNAME (PATTERN$,PDR$,PPREFIX$,PEXT$,FALSE) : _
  80.          PREV.PATTERN$ = PATTERN$
  81.       CALL BRKFNAME (ITEM.TO.MATCH$,IDR$,IPREFIX$,IEXT$,FALSE)
  82.       DOES.MATCH = FALSE
  83.       IF PDR$ <> "" AND PDR$ <> IDR$ THEN _
  84.          EXIT SUB
  85.       CALL WILDCARD (PPREFIX$,IPREFIX$)
  86.       IF NOT OK THEN _
  87.          EXIT SUB
  88.       CALL WILDCARD (PEXT$,IEXT$)
  89.       DOES.MATCH = OK
  90.       END SUB
  91. 20293 ' $SUBTITLE: 'SENDNAME - send FILENAME using EXEC-PC protocol'
  92. ' $PAGE
  93. '
  94. '  NAME    -- SENDNAME
  95. '
  96. '  INPUTS  --  PARAMETER                    MEANING
  97. '              B$()                ARRAY OF FILENAME FOR AUTODOWNLOAD
  98. '              DWN.INDEX           INDEX OF FILENAME TO TRANSFER
  99. '
  100. '  OUTPUTS --  ABORT               -1 FOR AN ABORTED ATTEMPT
  101. '
  102. '  PURPOSE -- Send the download filename to user during an autodownload
  103. '
  104.       SUB SENDNAME STATIC
  105. '
  106. '
  107. ' *  TRANSFER FILENAME TO USER
  108. ' *         PROCESS - SEND USER THE "ALERT" CHARACTER SEQUENCE -- <ESC>OD
  109. ' *                   THEN THIS IS FOLLOWED BY CHARACTER-BY-CHARACTER
  110. ' *                   TRANSMISSION OF THE FILENAME WITH ECHO.  IF ANY OF THE
  111. ' *                   CHARACTERS OF THE FILENMAE ARE GARBLED A SERIES OF
  112. ' *                   <CAN> ARE SENT, OTHERWISE AN <ACK> IS SENT AT
  113. ' *                   COMPLETION AND FILE TRANSFER BEGINS.
  114. '
  115. '
  116.       ABORT = FALSE                      ' RESET ABORT FLAG
  117.       ATTEMPTS = 0                       ' RESET COUNT FOR # OF TRANS ATTEMPTS
  118. 20295 CALL DELAYIT (1)                   ' ONE SECOND DELAY
  119. 20296 CALL FLUSHCOM(Y$)                  ' CLEAR THE COMM BUFFER OF GARBAGE
  120.       IF SUBROUTINE.PARAMETER = -1 THEN _
  121.          EXIT SUB
  122.       CALL PUTCOM (ESCAPE$+"OD")         ' SEND "ALERT" STRING
  123.       IF SUBROUTINE.PARAMETER = -1 THEN _
  124.          EXIT SUB
  125.       IF ABORT = TRUE THEN _
  126.          GOTO 20306
  127.       CALL LPRNT("Sending FILENAME -- ",1)
  128.       CALL LPRNT(RETURN.LINE.FEED$ + CHR$(9),0)
  129.       CALL DELAYIT (1)                   ' WAIT 1 SECOND FOR SETUP
  130. '
  131. '               SEND ONE CHARACTER AT A TIME
  132. '
  133.       CALL BRKFNAME (B$(DWN.INDEX),X$,A$,Y$,TRUE)
  134.       A$ = A$ + Y$ + "=X"
  135.       FOR X = 1 TO LEN(A$)
  136.          CALL PUTCOM (MID$(A$,X,1))     ' SEND 1 CHARACTER
  137.          IF SUBROUTINE.PARAMETER = -1 THEN _
  138.             EXIT SUB
  139.          IF ABORT = TRUE THEN _
  140.             GOTO 20306
  141.          CALL LPRNT(MID$(A$,X,1),0)     ' DISPLAY IF NEEDED
  142.          IF TIMER < 86390! THEN _
  143.             DELAY! = TIMER + 10 _
  144.          ELSE DELAY! = TIMER - 86400! + 10 ' SET MAXIMUM TIME TO WAIT FOR REPLY
  145.          CHAR% = TRUE
  146.          WHILE CHAR% = -1
  147.             IF TIMER > DELAY! THEN _
  148.                GOTO 20300     ' IF NO ECHO, CANCEL FILENAME TRANSFER
  149.             CALL EOFCOMM (CHAR%)
  150.          WEND                 ' JUMP OUT IF CHARACTER IS RECEIVED
  151. 20298    CALL FLUSHCOM(Y$)    ' COLLECT CHARACTER(S) USER ECHOED
  152.          IF SUBROUTINE.PARAMETER = -1 THEN _
  153.             EXIT SUB
  154.          IF MID$(A$,X,1) = Y$ THEN _
  155.             GOTO 20305         ' IF CORRECTLY ECHOED, THEN CONTINUE
  156.          IF INSTR(Y$,CANCEL$) THEN _
  157.             ABORT = TRUE : _
  158.             GOTO 20306          ' CHECK FOR USER ABORT
  159. 20300    CALL PUTCOM (STRING$(5,24)) ' TELL USER THAT FILE NAME IS GARBLED
  160.          IF SUBROUTINE.PARAMETER = - 1 THEN _
  161.             EXIT SUB
  162.          IF ABORT = TRUE THEN _
  163.             GOTO 20306
  164.          CALL LPRNT("Name Trans Failure",1) ' DISPLAY FAILURE ON SCREEN
  165.          ATTEMPTS = ATTEMPTS + 1  ' INCREMENT COUNTER FOR # OF TRIES
  166.          IF ATTEMPTS < 6 THEN _   ' TRY IT FIVE TIMES, THEN GIVE UP
  167.             GOTO 20295
  168.          CALL PUTCOM (STRING$(50,24)) ' GUARANTEE CANCELLATION OF USER
  169.          IF SUBROUTINE.PARAMETER = -1 THEN _
  170.             EXIT SUB
  171.          IF ABORT = TRUE THEN _
  172.             GOTO 20306
  173.          IF SNOOP THEN _
  174.             CALL LPRNT("ABORTING AUTODOWNLOAD!",1) : _
  175.             ABORT = TRUE : _
  176.             GOTO 20306
  177. '
  178. 20305 NEXT                               ' LOOP BACK FOR NEXT CHARACTER
  179. '
  180.       CALL PUTCOM (ACKNOWLEDGE$)    ' WHEN FILENAME SENT, ACKNOWLEDGE
  181.       IF SUBROUITNE.PARAMETER = -1 THEN _
  182.          EXIT SUB
  183.       CALL SKIPLINE(1)              ' CLEAN UP SYSOP'S DISPLAY
  184. '
  185. '                COMPLETION OF AUTODOWNLOAD FILENAME TRANSFER
  186. '
  187. 20306 END SUB
  188. 20310 ' $SUBTITLE: 'TESTUSER - interrogate user for AUTO-DOWNLOADING support'
  189. ' $PAGE
  190. '
  191. '  NAME    -- TESTUSER
  192. '
  193. '  INPUTS  -- NONE
  194. '
  195. '  OUTPUTS -- AUTODOWNLOAD.AVAILABLE   -1 IF USER'S COMMUNICATION
  196. '                                       SOFTWARE CAN DO AUTODOWNLOADING
  197. '
  198. '             AUTODOWNLOAD.VERIFIED    TRUE IF COMMUNICATIONS PGM
  199. '                                      EVER CHECKED
  200. '
  201. '  PURPOSE -- Send the user an <ESCAPE><XON> and if response
  202. '             is a recognized package, set appropriate flag.
  203. '
  204.       SUB TESTUSER STATIC
  205. '
  206. '
  207. ' *    TEST FOR COMMUNICATIONS USING N,8,1 PROTOCOL AND EXECPC TALK VER 2.0+
  208. ' *     TO SEE IF CALLER CAN USE THE AUTODOWNLOAD FEATURE
  209. '
  210. '
  211.       ABORT = FALSE
  212.       AUTODOWNLOAD.VERIFIED = TRUE
  213.       CALL FLUSHCOM(Y$)                          ' FLUSH THE COMM BUFFER
  214.       IF SUBROUTINE.PARAMETER = -1 THEN _
  215.          EXIT SUB
  216.       CALL PUTCOM (ESCAPE$ + XON$)
  217.       IF ABORT = TRUE THEN _
  218.          GOTO 20315
  219.       CALL DELAYIT (2)                            ' WAIT TWO SECONDS FOR REPLY
  220. 20313 CALL FLUSHCOM(Y$)                           ' GET CONTENTS OF COMM BUFFER
  221.       IF SUBROUTINE.PARAMETER = -1 THEN _
  222.          EXIT SUB
  223.       IF INSTR(Y$,"EXECPC") THEN _
  224.          COM.PROGRAM = 1
  225.       IF INSTR(Y$,"PIBTERM") THEN _
  226.          COM.PROGRAM = 2
  227.       IF INSTR(Y$,"PROCOMM") THEN _
  228.          COM.PROGRAM = 3
  229.       IF INSTR(Y$,"QMODEM") THEN _
  230.          COM.PROGRAM = 4
  231.       AUTODOWNLOAD.AVAILABLE = (COM.PROGRAM > 0 AND COM.PROGRAM < 3)
  232. 20315 END SUB
  233. '
  234. '
  235. ' ********* Maple UPDTU... ******
  236. '
  237. '
  238. 20705 ' $SUBTITLE: 'UPDTUPLOAD -- Updates upload directory'
  239. ' $PAGE
  240. '  SUBROUTINE NAME    -- UPDTUPLOAD
  241. '
  242. '  INPUT PARAMETERS   -- PARAMETER             MEANING
  243. '                        FILE.NAME$
  244. '                        UPLOAD.DIRECTORY$
  245. '                        FILE.NAME.HOLD$
  246. '                        SHARE.IT
  247. '                        FMS.DIRECTORY$
  248. '                        Q!
  249. '                        TCA!
  250. '
  251. '  OUTPUT PARAMETERS  -- BYTES.IN.FILE#
  252. '                        SECONDS.PER.SESSION!
  253. '
  254. '  SUBROUTINE PURPOSE -- UPON A SUCCESSFUL UPLOAD, ADD ENTRY TO THE UPLOAD
  255. '                        DIRECTORY AND GIVE ANY SESSION TIME CREDIT.
  256. '
  257.       SUB UPDTUPLOAD (CATEGORY.NAME$(1),CATEGORY.CODE$(1),LINES.IN.DESC,FF) STATIC '<===
  258.       ON FF GOTO 20710,20724,20723,20722
  259. 20710 ABORT = FALSE    ' PE ABORT MOD
  260.        CALL QTPUT1 ("Describe " + FILE.NAME.HOLD$ +CRLF$ + _
  261.            " (Begin with  /  if for SYSOP only) or enter ABORT to cancel")
  262.       CALL QTPUT1 (LEFT$(" |----+--Min<..-+---2+0---+---3+0---+---4+0---+-", _
  263.                  MAX.DESC.LEN - 4) + "..Max>")
  264.       CALL QTPUT ("? ",0)
  265.       A$ = ""
  266.       SUBROUTINE.PARAMETER = 1
  267.       PARSE.OFF = TRUE
  268.       CALL TGET
  269.       CALL CARRIER
  270.       IF SUBROUTINE.PARAMETER = -1 THEN _
  271.          B$ = "<description unavailable>": _
  272.          GOTO 20712
  273.       IF B$ = "ABORT" OR B$ = "abort" THEN _
  274.       ABORT = TRUE : _
  275.       EXIT SUB
  276.       IF LEN(B$) > MAX.DESC.LEN OR LEN(B$) < 5 THEN _
  277. CALL QTPUT (" Description must be 5 chars min," + STR$(MAX.DESC.LEN) + " chars max",1) : _ 
  278. CALL QTPUT (" ENTER the word ABORT to cancel transfer....",1) : _
  279.          GOTO 20710
  280. 20712 DESC$ = B$
  281.       IF NOT LIMIT.SEARCH.TO.FMS THEN _
  282.          IF FMS.DIRECTORY$ <> UPLOAD.DIRECTORY$ THEN _
  283.             IF LEFT$(B$,1) = "/" THEN _
  284.              GOTO 20722_
  285.             ELSE GOTO 20717
  286. '
  287. 20715  IF LEFT$(B$,1) = "/" OR LEFT$(B$,1) = "\" THEN _
  288.          B$ = MID$(B$(1),2) : _
  289.          UCAT$ = "***" : _
  290.          GOTO 20722
  291.       UCAT$ = DEFAULT.CATEGORY.CODE$
  292. 20717 IF SUBROUTINE.PARAMETER = -1 OR _
  293.       USER.SECURITY.LEVEL < SL.CATEGORIZE.UPLOADS THEN _
  294.       GOTO 20722
  295. 20719 CALL BUFFILE (UPCAT.HELP$,X)
  296. 20720 A$ = "Upload best fits what category (H=help)"
  297.       SUBROUTINE.PARAMETER = 1
  298.       CALL TGET
  299.       IF SUBROUTINE.PARAMETER = -1 THEN _
  300.          B$ = DEFAULT.CATEGORY.CODE$ : _
  301.          GOTO 20722
  302.       IF Q = 0 THEN _
  303.          GOTO 20719
  304.       CALL ALLCAPS (B$(1))
  305.       IF B$(1) = "H" OR _
  306.          B$(1) = "*" OR _
  307.          B$(1) = "?" THEN _
  308.          GOTO 20719
  309.       CALL CHKNARY (B$(1),CATEGORY.NAME$(),NUM.CATEGORIES,FOUND)
  310.       IF FOUND > 0 THEN _
  311.          UCAT$ = CATEGORY.CODE$(FOUND) : _
  312.          IF LEN(UCAT$) > 0 AND LEN(UCAT$) < 4 AND INSTR(UCAT$,",") = 0 THEN _
  313.             GOTO 20722
  314.       UCAT$ = ""
  315.       IF NOT LIMIT.SEARCH.TO.FMS THEN _
  316.          STREW.TO$ = DIRECTORY.PATH$ + _
  317.                      B$(1) + _
  318.                      "." + _
  319.                      DIRECTORY.EXTENTION$ : _
  320.          CALL FINDIT (STREW.TO$) : _
  321.          IF NOT OK THEN _
  322.             STREW.TO$ = "" _
  323.          ELSE GOTO 20722
  324.       CALL QTPUT ("No such category " + B$(1),1)
  325.       GOTO 20719
  326. 20722  IF USER.SECURITY.LEVEL >= ASK.EXTENDED.DESC AND _
  327.          MAX.EXTENDED.LINES > 0 AND SUBROUTINE.PARAMETER <> -1 THEN _
  328.          A$ = "Add an EXTENDED DESCRIPTION of " + _
  329.               FILE.NAME.HOLD$ + " (Y,[N])" : _
  330.          TURBO.KEY = -TURBO.KEY.USER : _
  331.          SUBROUTINE.PARAMETER = 1 : _
  332.          CALL TGET : _
  333.      IF SUBROUTINE.PARAMETER <> -1 THEN _
  334.         IF  YES THEN _
  335.        CALL SKIPLINE (2):_
  336.       CALL QTPUT (CHR$(7)+ " Description will be Entered AFTER the UPLOAD is Completed",2) : _
  337.     CALL DELAYIT (2) :_
  338.    GET.EXT.DESC = TRUE: _
  339.   EXIT SUB
  340.        EXIT SUB
  341. ' *********   routine AFTER the Upload is successfull and Extended = True *****
  342. 20723  IF NOT LIMIT.SEARCH.TO.FMS THEN _
  343.          STREW.TO$ = DIRECTORY.PATH$ + _
  344.                      B$(1) + _
  345.                      "." + _
  346.                      DIRECTORY.EXTENTION$
  347.        CALL FINDIT (STREW.TO$)
  348.          IF NOT OK THEN _
  349.             STREW.TO$ = ""
  350.       B$ = DESC$
  351.       X$ = DATE$
  352.       Z$ = LEFT$(X$,6) + _
  353.            RIGHT$(X$,2)
  354.       EN$ = STREW.TO$
  355.       GOSUB 20730
  356.       EN$ = ALWAYS.STREW.TO$
  357.       GOSUB 20730
  358.       GOTO 20728              'Pe 09/11/89
  359. '
  360. '***** ENTRY POINT WHEN UPLOAD is Finished ***********
  361. '
  362.  20724 GOSUB 20734
  363.  
  364. '
  365.       CALL TIMEREMAIN (TIME.REMAINING!)
  366.       IF PRIVATE.DOOR THEN _
  367.          X! = UPLOAD.TIME.FACTOR! * Q! _
  368.       ELSE X! = UPLOAD.TIME.FACTOR! * (TCA! - Q!)
  369. '
  370. '************************8 New Convert code begins here 8*******************
  371. ' Orig mods by Warren Muldrow
  372. '
  373. '      Zip Convert code.  Does the following:
  374. '
  375. '         .EXE files are retained as is (for self-extracting files)
  376. '
  377. '         .ZIP, .ARC, .PAK, .ZOO, and .LZH are unzrc'ed and then Zipped
  378. '
  379. '         All other files are Zipped
  380. '
  381. '      PKUNZIP, PKZIP, PKUNPAK, PAK, LHARC, ZOO.BAT, WHAT.EXE, and LOOZ.EXE
  382. '         should be in the DOS path or the RBBS directory.  WHAT is used by
  383. '         ZOO.BAT and is included in this archive.
  384. '
  385. '      The Library work path (Config parm # 304) is used for a work area
  386. '
  387.        IF ABORT = TRUE THEN _     'Corrects aborted uploads
  388.           EXIT SUB                'corrects aborted uploads
  389. '
  390. ' Allows SYSOP and users with security level to add new DIR entry
  391. ' the option to convert or not
  392. '                                  Pe 05/31/89 updated 06/12/89
  393. '
  394. IF SYSOP OR USER.SECURITY.LEVEL > = ADD.DIR.SECURITY THEN 
  395.   A$ = " Convert or verify " + FILE.NAME$ + " ([Y],N) "
  396.       SUBROUTINE.PARAMETER = 1
  397.       CALL TGET 
  398.     IF SUBROUTINE.PARAMETER = -1 THEN _
  399.      EXIT SUB
  400.    IF NO THEN _
  401.         GOTO 20727
  402. END IF
  403. ' **********************************End of 05/31/89 mod
  404. IF NOT LOCAL.USER THEN _
  405.     GOTO 20725
  406.        CALL BRKFNAME (FILE.NAME$, DR$, ZZ$, X$, TRUE)
  407.        IF X$ = ".EXE" OR X$ = "" OR EXT$ = ".SFX" THEN _
  408.           GOTO 20727
  409.        IF X$ = ".ZIP" THEN _
  410.           CALL QTPUT (FILE.NAME.HOLD$ +" Now being verified and re-Zipped Please wait!",1) : _
  411.           Z$ = "PKUNZIP -x " + FILE.NAME$ + " " _
  412.        ELSE _
  413.           CALL QTPUT (FILE.NAME.HOLD$ +" Now being converted to .ZIP format. Please wait!",1) : _
  414.           IF X$ = ".ARC" OR X$ = ".PAK" THEN _
  415.              Z$ = "PAK e " + FILE.NAME$ + " " : _
  416.           ELSE IF X$ = ".LZH" THEN _
  417.              Z$ = "LHARC e " + FILE.NAME$ + " " : _
  418.           ELSE IF X$ = ".ZOO" THEN _
  419.              Z$ = "ZOO.BAT " + FILE.NAME$ + " " : _
  420.           ELSE _
  421.              SHELL "PKZIP -m -ex " + DR$ + ZZ$ + " " + FILE.NAME$ : _ 
  422.              Z$ = "" :
  423.        IF Z$ <> "" THEN _
  424.           SHELL "MD " + LIBRARY.WORK.DISK.PATH$ + NODE.ID$ : _
  425.           SHELL Z$ + " " + LIBRARY.WORK.DISK.PATH$ + NODE.ID$ + "\" : _
  426.           SHELL "DEL " + FILE.NAME$ : _
  427.           SHELL "PKZIP -m -ex " + DR$ + ZZ$ + " " + _ 
  428.                  LIBRARY.WORK.DISK.PATH$ + NODE.ID$ + "\*.*" : _
  429.        SHELL "RD " + LIBRARY.WORK.DISK.PATH$ + NODE.ID$
  430.        FILE.NAME.HOLD$ = ZZ$ + ".ZIP"
  431.        FILE.NAME$ = DR$ + FILE.NAME.HOLD$
  432. '
  433. 20725 IF LOCAL.USER THEN _
  434.         GOTO 20726
  435.        CALL BRKFNAME (FILE.NAME$, DR$, ZZ$, X$, TRUE)
  436.        IF X$ = ".EXE" OR X$ = "" OR EXT$ = ".SFX" THEN _
  437.           GOTO 20727
  438.        IF X$ = ".ZIP" THEN _
  439.           CALL QTPUT (FILE.NAME.HOLD$ +" Now being verified and re-Zipped Please wait!",1) : _
  440.           Z$ = "PKUNZIP -x " + FILE.NAME$ + " " _
  441.        ELSE _
  442.           CALL QTPUT (FILE.NAME.HOLD$ +" Now being converted to .ZIP format. Please wait!",1) : _
  443.           IF X$ = ".ARC" OR X$ = ".PAK" THEN _
  444.              Z$ = "PAK e " + FILE.NAME$ + " " : _
  445.           ELSE IF X$ = ".LZH" THEN _
  446.              Z$ = "LHARC e " + FILE.NAME$ + " " : _
  447.           ELSE IF X$ = ".ZOO" THEN _
  448.              Z$ = "ZOO.BAT " + FILE.NAME$ + " " : _
  449.           ELSE _
  450.              SHELL "PKZIP -m -ex " + DR$ + ZZ$ + " " + FILE.NAME$ : _ 
  451.              Z$ = ""
  452.        IF Z$ <> "" THEN _
  453.           B$ = "CONVERT"+NODE.ID$+".BAT" : _
  454.           CALL OPENOUTW (B$) : _
  455.           PRINT #2, "MD " + LIBRARY.WORK.DISK.PATH$ + NODE.ID$ : _
  456.           PRINT #2, "ECHO OFF": _
  457.           PRINT #2, "CTTY GATE"+RIGHT$(COM.PORT$,1) : _
  458.           PRINT #2,  Z$ + " " + LIBRARY.WORK.DISK.PATH$ + NODE.ID$ + "\" : _
  459.           PRINT #2,  "DEL " + FILE.NAME$ : _
  460.           PRINT #2, "IF ERRORLEVEL = 1 GOTO ERR " : _
  461.           PRINT #2, "PKZIP -m -ex " + DR$ + ZZ$ + " " + _ 
  462.                  LIBRARY.WORK.DISK.PATH$ + NODE.ID$ + "\*.*" : _
  463.           PRINT #2,":ERR" : _
  464.           PRINT #2, "CTTY CON" : _
  465.           PRINT #2,  "KDY " + LIBRARY.WORK.DISK.PATH$ + NODE.ID$ : _
  466.           PRINT #2,"SETERROR 0" : _
  467.           PRINT #2, "ECHO ON"
  468. IF FOSSIL THEN _
  469.     CALL FOSEXIT(COMPORT%)_
  470. ELSE CLOSE 3 : _
  471.        OUT MODEM.CONTROL.REGISTER,INP(MODEM.CONTROL.REGISTER) OR 1 : _
  472.        CLOSE 2 :_
  473.        SHELL B$
  474.       IF FOSSIL THEN _
  475.         CALL FOSINIT(COMPORT%,RESULT%) : _
  476.          IF RESULT% = -1 THEN _
  477.            CALL PSCRN("ERROR INITIALIZING FOSSIL AFTER EXTERNAL PROTOCOL") : _
  478.             SYSTEM
  479.        PARITY$ = MID$(",N,8,1,E,7,1",7 + 6 * EIGHT.BIT,6)
  480.       IF FOSSIL THEN _
  481.          CALL SETBAUD _
  482.       ELSE CALL OPENCOM(TALK.TO.MODEM.AT$,PARITY$)
  483.        FILE.NAME.HOLD$ = ZZ$ + ".ZIP"
  484.        FILE.NAME$ = DR$ + FILE.NAME.HOLD$
  485. '
  486. '
  487. ' Comment code added here
  488. '
  489. 20726 CALL FINDIT (FILE.NAME$)
  490.       IF OK THEN
  491.        CLOSE 2
  492.      COMMENT.NAME$ = UPLOAD.SUBDIR$ +"\UPLOAD.CMT
  493.      ADDCMT1$ =CRLF$ +"Uploaded to "+ RBBS.NAME$ +" By: "+ACTIVE.USER.NAME$
  494.      ADDCMT2$ = CRLF$ +"Description: " + DESC$
  495.      ADDCOMMENT$ =  ADDCMT1$ + ADDCMT2$ + CRLF$
  496.           CALL OPENOUTW (COMMENT.NAME$)
  497.          PRINT #2, ADDCOMMENT$
  498.        CLOSE 2
  499.       ADDCMT$ = LIBRARY.ARCHIVE.PATH$+"PKZIP -z<"+COMMENT.NAME$+" "+ FILE.NAME$
  500.    SHELL ADDCMT$ 
  501. END IF
  502. 20727 GOSUB 20734     'Pe 09/06/89
  503.        CALL QTPUT(CX$(5)+"Upload successful,Thanks for the file "+CX$(2) + FIRST.NAME$+CX$(7),1)
  504. OK = 0
  505.       CALL CHECKNOVELL (OK)
  506.       IF OK <> -1 THEN _
  507.          CALL SETSHAREDATTR (FILE.NAME$, OK) : _
  508.          IF OK <> 0 THEN _
  509.             CALL PSCRN ("Error setting shared attribute")
  510.       IF GET.EXT.DESC THEN _
  511.          EXIT SUB     
  512.        X$ = DATE$
  513.        Z$ = LEFT$(X$,6) + RIGHT$(X$,2)
  514.        STREW.TO$ = ""
  515.        B$ = DESC$
  516.        EN$ = ALWAYS.STREW.TO$
  517.        GOSUB 20730
  518.        EN$ = STREW.TO$
  519.        GOSUB 20730 
  520. '
  521. 20728  IF FMS.DIRECTORY$ <> UPLOAD.DIRECTORY$ THEN _ 
  522.           IF LEFT$(B$,1) = "/" OR LEFT$(B$,1) = "\" THEN _
  523.              CALL UPDTCALR (B$,2): _
  524.              GOTO 20729
  525. '******************
  526.   EN$ = UPLOAD.DIRECTORY$
  527.        GOSUB 20730
  528. 20729 DF$ = " >> uploaded << "
  529.       UPLOADS = UPLOADS + 1
  530.       GLOBAL.UPLOADS = GLOBAL.UPLOADS + 1
  531.       ULBYTES! = ULBYTES! + BYTES.IN.FILE#
  532.       GLOBAL.ULBYTES! = GLOBAL.ULBYTES! + BYTES.IN.FILE#
  533.       CALL MUZAK (7)
  534.       CALL TIMEREMAIN (TIME.REMAINING!)
  535.       TIME.CREDITS! = TIME.CREDITS! + X!
  536.       SECONDS.PER.SESSION! = SECONDS.PER.SESSION! + X!
  537.       IF PRIVATE.DOOR THEN _
  538.          X! = (X! - Q!) / 60.0 _
  539.       ELSE X! = (X! - TCA! + Q!)/60.0
  540.       X$ = STR$(FIX(X!*10.0))
  541.       X$ = LEFT$(X$,LEN(X$)-1) + "." + RIGHT$(X$,1)
  542.       IF X! > 1.0 THEN _
  543.          CALL QTPUT1 ("Uploads are appreciated here.  For today your") : _
  544.          CALL QTPUT1 ("SESSION & DAILY time limits increased by"+X$+" minutes")
  545.       GET.EXT.DESC = FALSE
  546.  IF  AUTO.END = 1 THEN _
  547.     FILESYS.PARAMETER = 7 : _ 
  548.     DOWNLOAD.COMPLETED = TRUE 
  549.       EXIT SUB
  550. 20730 '          ---[ lock file ]---
  551.       IF EN$ = "" THEN _
  552.          RETURN
  553.       FMS.FORMAT = FALSE
  554.       IF EN$ = FMS.DIRECTORY$ OR LIMIT.SEARCH.TO.FMS THEN _
  555.          FMS.FORMAT = TRUE _
  556.       ELSE CALL FINDIT (EN$) : _
  557.            IF OK THEN _
  558.               CALL READDIR (1) : _
  559.               IF EC = 0 THEN _
  560.                  FMS.FORMAT = (LEFT$(A$,4) = "\FMS")
  561.       IF NOT FMS.FORMAT THEN _
  562.          READ.BACKWARDS = FALSE : _
  563.          FIXED.LEN = 0 : _
  564.          B$ = DESC$ _
  565.       ELSE FIXED.LEN = 34 + MAX.DESC.LEN : _
  566.            B$ = DESC$ + _
  567.                 SPACE$(MAX.DESC.LEN - LEN(DESC$)) + _
  568.                 UCAT$ + _
  569.                 SPACE$(3 - LEN(UCAT$)) : _
  570.            READ.BACKWARDS = TRUE : _
  571.            CALL FINDIT (EN$) : _
  572.            IF OK THEN _
  573.               CALL READDIR (2,1) : _
  574.               IF EC = 0 THEN _
  575.                  READ.BACKWARDS = (INSTR(A$," TOP ") = 0)
  576. CALL LOCKAPPND
  577.       IF EC <> 0 THEN _
  578.          GOTO  20731
  579.      '          ---[ append ]---
  580.       IF GET.EXT.DESC THEN _
  581.          IF READ.BACKWARDS THEN _
  582.             FOR I = LINES.IN.DESC TO 1 STEP -1 : _
  583.                GOSUB 20732 : _
  584.             NEXT
  585.       PRINT #2,USING "\           \########  &  &"; _
  586.                      FILE.NAME.HOLD$; _
  587.                      BYTES.IN.FILE#; _
  588.                      Z$; _
  589.                      B$
  590.       IF GET.EXT.DESC THEN _
  591.          IF NOT READ.BACKWARDS THEN _
  592.             FOR I = 1 TO LINES.IN.DESC : _
  593.                GOSUB 20732 : _
  594.             NEXT
  595.  20731 CALL UNLKAPPND
  596.       FIXED.LEN = 0
  597.       RETURN
  598. 20732 X$ = A$(I)
  599.       CALL TRIM (X$)
  600.       IF X$ = "" THEN _
  601.          RETURN
  602.       IF NOT FMS.FORMAT THEN _
  603.          PRINT #2,"  ";A$(I) : _
  604.          RETURN
  605.       IF FIXED.LEN > LEN(A$(I)) THEN _
  606.          X$ = SPACE$(FIXED.LEN - 1 - LEN(A$(I))) + "." _
  607.       ELSE X$ = ""
  608.       PRINT #2, "  ";LEFT$(A$(I),FIXED.LEN);X$
  609.       RETURN
  610. 20734 CALL FINDIT (FILE.NAME$)
  611. 20736 IF NOT OK THEN _
  612.          BYTES.IN.FILE# = 0.0_
  613.       ELSE BYTES.IN.FILE# = LOF(2)
  614.       IF BYTES.IN.FILE# < 2.0 THEN _
  615.          EXIT SUB
  616.       RETURN
  617.       END SUB
  618. 20741 ' $SUBTITLE: 'BADFILE - subroutine to find bad file names'
  619. ' $PAGE
  620. '
  621. '  NAME    -- BADFILE
  622. '
  623. '  INPUTS  --     PARAMETER                    MEANING
  624. '               VIOLATION$
  625. '               VIOLATIONS.THIS.SESSION
  626. '               FILNAME$                      NAME OF FILE
  627. '
  628. '  OUTPUTS -- RESULT                      1 = FILE NAME IS OK
  629. '                                         2 = CHARACTER NOT ALLOWED
  630. '                                         3 = SYSTEM CRASH ATTEMPT
  631. '             VIOLATIONS.THIS.SESSION     NUMBER OF VIOLATIONS
  632. '             FILNAME$                    Gets capitalized
  633. '
  634. '  PURPOSE -- To protect RBBS-PC against the use of bad file names
  635. '             to either crash the system or to breach RBBS-PC's security.
  636. '
  637.       SUB BADFILE (FILNAME$,RESULT) STATIC
  638. '
  639. '
  640. ' *  TEST FOR INVALID CHARACTERS IN FILENAME
  641. '
  642. '
  643.       RESULT = 2
  644.       IF LEN(FILNAME$) < 1 THEN _
  645.          EXIT SUB
  646.       CALL BADFILECHAR (FILNAME$,OK)
  647.       IF NOT OK THEN _
  648.          EXIT SUB
  649.       IF RIGHT$(FILNAME$,1) = "." THEN _
  650.            EXIT SUB
  651.       CALL ALLCAPS (FILNAME$)
  652.       XX = INSTR(FILNAME$,".")
  653.       IF XX > 0 THEN _
  654.          XX = INSTR(XX + 1,FILNAME$,".") : _
  655.          IF XX > 0 THEN _
  656.             EXIT SUB
  657.       XX = LEN(FILNAME$)
  658.       IF XX => 3 THEN _
  659.          IF INSTR("PRN:CON:AUX:NUL:",FILNAME$) THEN _
  660.             GOTO 20742
  661.       IF XX => 4 THEN _
  662.          IF INSTR("COM1:COM2:LPT1:LPT2:LPT3:SCRN:KYBD:CONS:",FILNAME$) THEN _
  663.             GOTO 20742
  664.       CALL BRKFNAME (FILNAME$,PRE$,BODY$,EXT$,FALSE)
  665.       IF LEN(PRE$) > 64 OR LEN(BODY$) > 8 OR LEN(BODY$) < 1 OR LEN(EXT$) > 3 THEN _
  666.          EXIT SUB
  667.       XX = LEN(BODY$)
  668.       IF XX => 3 THEN _
  669.          IF INSTR("PRN:CON:AUX:NUL:",BODY$) THEN _
  670.             GOTO 20742
  671.       IF XX => 4 THEN _
  672.          IF INSTR("COM1:COM2:LPT1:LPT2:LPT3:SCRN:KYBD:CONS:",BODY$) THEN _
  673.             GOTO 20742
  674.       RESULT = 1
  675.       EXIT SUB
  676. 20742 VIOLATIONS.THIS.SESSION = MAXIMUM.VIOLATIONS
  677.       VIOLATION$ = VIOLATION$ + _
  678.                    FILNAME$
  679.       RESULT = 3
  680.       END SUB
  681. '
  682. 21105 ' $SUBTITLE: 'LIBRARY - sub to support Library downloads'
  683. ' $PAGE
  684. '
  685. '  NAME    -- LIBRARY
  686. '
  687. '  INPUTS  --     PARAMETER                    MEANING
  688. '              SUBROUTINE.PARAMETER     1 = DISPLAY ACTIVE AREA
  689. '                                       2 = CHANGE ACTIVE AREA
  690. '                                       3 = DISPLAY PC-SIG
  691. '                                           DISCLAIMER
  692. '                                       4 = ARCHIVE LIBRARY DISK
  693. '                                       5 = DOWNLOAD COMPLETED
  694. '              LIBRARY.TYPE             0 = NO LIBRARY ACTIVE
  695. '                                       1 = LIBRARY FROM PC-SIG
  696. '              LIBRARY.DRIVE$           LIBRARY DRIVE ID
  697. '
  698. '  OUTPUTS -- NONE
  699. '
  700. '  PURPOSE -- To provide access support for library drives
  701. '
  702.       SUB LIBRARY STATIC
  703.       STATIC LIBRARY.SUBDIR.NAME$(1)
  704.       STATIC DISK.TITLE$
  705.       EC = 0
  706.       IF LIBRARY.TYPE = 0 THEN _
  707.          EXIT SUB
  708.       IF LIBRARY.DISK.CHAR$ = "" THEN _
  709.          LIBRARY.DISK.CHAR$ = "0000"
  710.       ON SUBROUTINE.PARAMETER GOTO 21110, 21115, 21130, 21140, 21159
  711. 21110 IF LIBRARY.DISK.CHAR$ = "0000" THEN _
  712.          A$ = "No Library disk currently selected" _
  713.       ELSE A$ = "Library disk " + _
  714.                 LIBRARY.DISK.CHAR$ + _
  715.                 " selected - " + _
  716.                 DISK.TITLE$
  717.       CALL QTPUT1 (A$)
  718.       IF LIBRARY.DISK.ARCHIVE$ = "" THEN _
  719.          EXIT SUB
  720.       FOR LIBRARY.DISPLAY.COUNT = 0 TO LIBRARY.LOOP.COUNT - 1
  721.          IF LIBRARY.SUBDIR.NAME$(LIBRARY.DISPLAY.COUNT) <> "" THEN _
  722.             CALL QTPUT1 (LIBRARY.SUBDIR.NAME$(LIBRARY.DISPLAY.COUNT) + _
  723.                        "." + DEFAULT.EXTENSION$ + " ready for transmission!")
  724.       NEXT
  725.       EXIT SUB
  726. 21115 IF Q = 1 THEN _
  727.          A$ = "Change Library disk from " + _
  728.               LIBRARY.DISK.CHAR$ + _
  729.               " to (1 -" + _
  730.               STR$(LIBRARY.MAX.DISK) + _
  731.               ")" : _
  732.          SUBROUTINE.PARAMETER = 1 : _
  733.          CALL TGET : _
  734.          IF SUBROUTINE.PARAMETER = -1 THEN _
  735.             EXIT SUB _
  736.          ELSE IF Q = 0 THEN _
  737.                  LIBRARY.DISK.CHAR$ = "0000" : _
  738.                  CHDIR.LIBRARY$ = LIBRARY.DRIVE$ + _
  739.                                   "\" : _
  740.                  GOTO 21126
  741. 21117 IF VAL(B$(Q)) < 1 OR VAL(B$(Q)) > LIBRARY.MAX.DISK THEN _
  742.          Q = 1 : _
  743.          GOTO 21115
  744. 21120 LIBRARY.DISK.CHAR$ = B$(Q)
  745.       CLOSE 2
  746.       LIBRARY.DISK.CHAR$ = RIGHT$("0000" + LIBRARY.DISK.CHAR$,4)
  747. 21121 CALL FINDIT("RBBS-CDR.DEF")
  748.       IF EC <> 0 THEN _
  749.          EXIT SUB
  750. 21122 IF EOF(2) THEN _
  751.          LIBRARY.DISK.CHAR$ = "" : _
  752.          EXIT SUB
  753.       INPUT #2,WORK.SUBDIR$,CHDIR.LIBRARY$
  754.       LINE INPUT #2,DISK.TITLE$
  755.       IF LIBRARY.DISK.CHAR$ = WORK.SUBDIR$ THEN _
  756.          CHDIR.LIBRARY$ = LIBRARY.DRIVE$ + _
  757.                           CHDIR.LIBRARY$ : _
  758.          GOTO 21126
  759.       GOTO 21122
  760. 21126 EC = 0
  761.       CALL CHANGEDIR (CHDIR.LIBRARY$)
  762.       IF EC <> 0 THEN _
  763.          LIBRARY.DISK.CHAR$ = "0000" : _
  764.          CHDIR.LIBRARY$ = LIBRARY.DRIVE$ + _
  765.                           "\" : _
  766.          GOTO 21126
  767.       EXIT SUB
  768. 21130 IF LIBRARY.TYPE <> 1 THEN _
  769.          EXIT SUB
  770.       CALL SKIPLINE(1)
  771.       A$ = "PC-SIG Library is being accessed.  The file that you are about"
  772.       CALL QTPUT1 (A$)
  773.       A$ = "to download can also be obtained by ordering DISK " + _
  774.            LIBRARY.DISK.CHAR$
  775.       CALL QTPUT1 (A$)
  776.       A$ = "from PC-SIG, 1030D East Duane Ave. Sunnyvale, Ca. 94086"
  777.       CALL QTPUT (A$,2)
  778.       EXIT SUB
  779. 21140 IF LIBRARY.DISK.CHAR$ = "0000" THEN _
  780.          CALL QTPUT1 ("You must select a LIBRARY disk first!") : _
  781.          EXIT SUB
  782.       A$ = "Archive contents of Library disk - " + _
  783.            LIBRARY.DISK.CHAR$ + _
  784.            " for data transmission (Y/[N])"
  785.       SUBROUTINE.PARAMETER = 1
  786.       CALL TGET
  787.       IF NOT LOCAL.USER THEN _
  788.          IF SUBROUTINE.PARAMETER = -1 THEN _
  789.             EXIT SUB
  790.       IF NOT YES THEN _
  791.          EXIT SUB
  792. 21145 CALL KILLWORK (LIBRARY.WORK.DISK.PATH$ + _
  793.                     LIBRARY.NODE.ID$ + _
  794.                     "DK*." + DEFAULT.EXTENSION$)
  795. 21150 CALL QTPUT1 ("Work/RAM disk has been purged")
  796.       CALL QTPUT1 ("Beginning archive using " + _
  797.                   LIBRARY.ARCHIVE.PROGRAM$ + _
  798.                   " Please be patient!")
  799.       REDIM LIBRARY.SUBDIR.NAME$(10)
  800.       LIBRARY.SUBDIR.CHAR$ = ""
  801.       LIBRARY.LOOP.COUNT = 0
  802.       GOSUB 21157
  803.       A$ = "Contents of Library disk - " + _
  804.            LIBRARY.DISK.CHAR$ + _
  805.            " now archived for data transmission"
  806.       CALL QTPUT1 (A$)
  807.       A$ = "Searching for Sub-directories"
  808.       CALL QTPUT1 (A$)
  809.       GOSUB 21158
  810.       LIBRARY.DISK.ARCHIVE$ = LIBRARY.DISK.CHAR$
  811. '
  812. ' SEARCH AND ARCHIVE ANY SUBDIRECTORIES
  813. '
  814.       TREEDIR$ = LIBRARY.WORK.DISK.PATH$ + _
  815.                  LIBRARY.NODE.ID$ + _
  816.                  "DKDIR.LST"
  817.       DIRCMD$ = "DIR " + _
  818.                 LIBRARY.DRIVE$ + _
  819.                 " | FIND " +  _
  820.                 CHR$(34) + _
  821.                 " <DIR> " + _
  822.                 CHR$(34) + _
  823.                 "  > " + _
  824.                 TREEDIR$
  825. 21151 SHELL DIRCMD$
  826.       CALL SKIPLINE (2)
  827.       LOCATE 24,1
  828.       EC = 0
  829. 21152 CLOSE 2
  830. 21153 CALL OPENWORK (2,TREEDIR$)
  831.       LIBRARY.SUBDIR.COUNT = 0
  832.       WHILE NOT EOF(2)
  833.          LINE INPUT #2, DIRREC$
  834.          IF LEFT$(DIRREC$,1) <> "." THEN _
  835.             LIBRARY.SUBDIR.COUNT = LIBRARY.SUBDIR.COUNT + 1 : _
  836.             LIBRARY.SUBDIR.NAME$(LIBRARY.SUBDIR.COUNT) = _
  837.             LEFT$(DIRREC$,8)
  838.       WEND
  839.       CLOSE 2
  840.       LIBRARY.LOOP.COUNT = 1
  841.       IF LIBRARY.SUBDIR.COUNT = 0 THEN _
  842.          GOTO 21156
  843.       A$ = "There are" + STR$(LIBRARY.SUBDIR.COUNT) + _
  844.            " Subdirectories on LIBRARY disk - " + _
  845.            LIBRARY.DISK.CHAR$
  846.       CALL QTPUT1 (A$)
  847.       FOR LIBRARY.LOOP.COUNT = 1 TO LIBRARY.SUBDIR.COUNT
  848.          IF NOT LOCAL.USER THEN _
  849.             CALL CARRIER : _
  850.             IF SUBROUTINE.PARAMETER THEN _
  851.                GOTO 21155
  852.          LIBRARY.SUBDIR.CHAR$ = MID$("ABCDEFGHI",LIBRARY.LOOP.COUNT,1)
  853.          A$ = "Creating " + _
  854.               LIBRARY.NODE.ID$ + _
  855.               "DK" + _
  856.               LIBRARY.DISK.CHAR$ + _
  857.               LIBRARY.SUBDIR.CHAR$ + _
  858.               ".ARC using " + LIBRARY.ARCHIVE.PROGRAM$
  859.          CALL QTPUT1 (A$)
  860.          CHDIR CHDIR.LIBRARY$ + _
  861.                "\" + _
  862.                LIBRARY.SUBDIR.NAME$(LIBRARY.LOOP.COUNT)
  863.          GOSUB 21157
  864.          A$ = "Disk - " + _
  865.               LIBRARY.DISK.CHAR$ + _
  866.               "; Subdirectory" + _
  867.               " -" + _
  868.               STR$(LIBRARY.LOOP.COUNT) + _
  869.               " has been archived for data transmission"
  870.          CALL QTPUT1 (A$)
  871.          GOSUB 21158
  872. 21155 NEXT LIBRARY.LOOP.COUNT
  873. 21156 CALL CARRIER
  874.       A$ = ""
  875.       EXIT SUB
  876. 21157 LIBRARY.ARCHIVE$ = LIBRARY.ARCHIVE.PATH$ + _
  877.                        LIBRARY.ARCHIVE.PROGRAM$ + _
  878.                        " " + _
  879.                        LIBRARY.WORK.DISK.PATH$ + _
  880.                        LIBRARY.NODE.ID$ + _
  881.                        "DK" + _
  882.                        LIBRARY.DISK.CHAR$ + _
  883.                        LIBRARY.SUBDIR.CHAR$ + _
  884.                        " " + _
  885.                        LIBRARY.DRIVE$ + _
  886.                        "*.*"
  887.       IF USE.DEVICE.DRIVER$ <> "" AND FOSSIL THEN _
  888.          LIBRARY.ARCHIVE$ = DISK.FOR.DOS$ + _
  889.                             "COMMAND /C " + _
  890.                             LIBRARY.ARCHIVE$ + _
  891.                             " > " + _
  892.                             USE.DEVICE.DRIVER$
  893.       SHELL LIBRARY.ARCHIVE$
  894.       CALL SKIPLINE (2)
  895.       LOCATE 24,1
  896.       RETURN
  897. 21158 LIBRARY.SUBDIR.NAME$(LIBRARY.LOOP.COUNT) = LIBRARY.NODE.ID$ + _
  898.                                              "DK" + _
  899.                                              LIBRARY.DISK.CHAR$ + _
  900.                                              LIBRARY.SUBDIR.CHAR$
  901.       RETURN
  902. 21159 FOR LIBRARY.DISPLAY.COUNT = 0 TO LIBRARY.LOOP.COUNT - 1
  903.          IF LIBRARY.SUBDIR.NAME$(LIBRARY.DISPLAY.COUNT) = A$ THEN _
  904.             LIBRARY.SUBDIR.NAME$(LIBRARY.DISPLAY.COUNT) = ""
  905.       NEXT
  906.       END SUB
  907. 21598 ' $SUBTITLE: 'XFERTYPE - sub to identify file xfer protocol'
  908. ' $PAGE
  909. '
  910. '  NAME    -- XFERTYPE
  911. '
  912. '  INPUTS  --     PARAMETER                    MEANING
  913. '               INDEX            = 1       Manual select for up/download
  914. '                                = 2       Default select
  915. '                                = 3       Set transfer default
  916. '               A$
  917. '               B$(1)
  918. '               Q
  919. '               RELIABLE.MODE
  920. '               TRANSFER.OPTIONS$
  921. '               USER.TRANSFER.DEFAULT$
  922. '               XFER.SUPPORT
  923. '
  924. '  OUTPUTS   -- CHECKSUM
  925. '               FLEN
  926. '               FT$
  927. '
  928. '  PURPOSE -- To identify the file transfer protocol (either
  929. '             from the user's default or via explicit selection)
  930. '
  931.       SUB XFERTYPE(INDEX,SKIP.HELP) STATIC
  932.       IF TRANSFER.OPTIONS$ = "" OR USER.SECURITY.LEVEL <> PREV.USL THEN _
  933.          CALL PROTOCOL : _
  934.          PREV.USL = USER.SECURITY.LEVEL
  935.       X$ = A$ + "Protocol"
  936.       ON INDEX GOTO 21600,21620,21600                                ' KG081201
  937. '
  938. '
  939. ' *  MANUAL SELECT OF TRANSFER PROTOCOL
  940. '
  941. '
  942. 21600 IF SKIP.HELP THEN _
  943.          GOTO 21604
  944. 21602 CALL BUFFILE (HELP.PATH$ + "UF" + HELP.EXTENSION$,X)
  945.       IF SUBROUTINE.PARAMETER = -1 THEN _
  946.          EXIT SUB
  947. 21604 STOP.INTERRUPTS = TRUE                                         ' KG081201
  948.       IF INDEX = 3 THEN _                                            ' KG081201
  949.          IF ANS.INDEX < LAST.INDEX THEN _                            ' KG081201
  950.             GOTO 21605                                               ' KG081201
  951.       CALL QTPUT1 (X$)
  952.       CALL BUFSTRNG (TRANSFER.OPTIONS$,4096,X)                       ' KG081201
  953.       CALL QTPUT (MID$("?!",1-TURBO.KEY.USER,1)+" ",0)               ' KG081201
  954. 21605 A$ = ""
  955.       TURBO.KEY = -TURBO.KEY.USER                                    ' KG081201
  956.       MACRO.MIN = 2
  957.       SUBROUTINE.PARAMETER = 1
  958.       IF INDEX = 3 THEN _                                            ' KG081201
  959.          CALL POPCSTACK : _                                          ' KG081201
  960.          X = ANS.INDEX _                                             ' KG081201
  961.       ELSE SUBROUTINE.PARAMETER = 1 : _                              ' KG081201
  962.            CALL TGET : _                                             ' KG081201
  963.            X = 1                                                     ' KG081201
  964.       IF SUBROUTINE.PARAMETER = -1 THEN _
  965.          EXIT SUB
  966.       IF Q = 0 THEN _
  967.          GOTO 21604
  968. 21606 Z$ = B$(X)                                                     ' KG081201
  969. '
  970. '
  971. ' *  DEFAULT SELECT OF TRANSFER PROTOCOL
  972. '
  973. '
  974. 21610 CALL ALLCAPS (Z$)
  975.       IF INSTR("H?",Z$) > 0 THEN _
  976.          GOTO 21602
  977.       FF = INSTR(DFLTXFER$,Z$)
  978.       IF FF < 1 THEN _
  979.          GOTO 21600
  980. 21612 FT$ = MID$(DFLTXFER$,FF,1)
  981.       INTERNAL.PROTO$ = MID$(INTERNAL.EQUIV$,FF,1)
  982.       GOTO 21621
  983. 21620 FF = -1
  984.       IF COMMAND.TRANSFER$ <> "" THEN _
  985.          Z$ = COMMAND.TRANSFER$ : _
  986.          GOTO 21610
  987.       X = INSTR(DFLTXFER$,USER.TRANSFER.DEFAULT$)
  988.       IF X > 0 THEN _
  989.          IF MID$(INTERNAL.EQUIV$,X,1) <> "N" THEN _
  990.             Z$ = USER.TRANSFER.DEFAULT$ : _
  991.             GOTO 21610
  992.       PROTO.PROMPT$ = "None"
  993.       FF = 0
  994.       EXIT SUB
  995. 21621 IF FF = PREV.FF AND PREV.PROTO.DEF$ = PROTO.DEF$ THEN _
  996.          PROTO.PROMPT$ = PREV.PROTO.PROMPT$ : _
  997.          EXIT SUB
  998.       PREV.FF = FF
  999.       PREV.PROTO.DEF$ = PROTO.DEF$
  1000.       INTERNAL.PROTO$ = MID$(INTERNAL.EQUIV$,FF,1)
  1001.       CHECKSUM = (INTERNAL.PROTO$ = "X")
  1002.       CALL FINDIT (PROTO.DEF$)
  1003.       IF OK THEN _
  1004.          GOTO 21623
  1005.       X = INSTR("AXCYN",INTERNAL.PROTO$)
  1006.       IF X < 1 THEN _
  1007.          INTERNAL.PROTO$ = "N"
  1008.       PROTO.PROMPT$ = MID$("Ascii     Xmodem    Xmodem/CRCYmodem    None",10*INSTR("AXCYN",INTERNAL.PROTO$)-9,10)
  1009.       CALL TRIMTRAIL (PROTO.PROMPT$," ")
  1010.       CHECKSUM = (INTERNAL.PROTO$ = "X")
  1011.       FLEN = 128 - 896 * (INTERNAL.PROTO$ = "Y")
  1012.       BLOCK.SIZE = FLEN
  1013.       IF INTERNAL.PROTO$ = "Y" THEN _
  1014.          SPEED.FACTOR! = 0.87 _
  1015.       ELSE IF INTERNAL.PROTO$ = "A" THEN _
  1016.          SPEED.FACTOR! = 0.92 _
  1017.       ELSE SPEED.FACTOR! = 0.78
  1018.       GOTO 21625
  1019. 21623 CALL READPARMS (WORK.ARA$(),13,FF)
  1020.       IF EC > 0 THEN _
  1021.          FF = LEN(DFLTXFER$) : _
  1022.          PROTO.PROMPT$ = "None" : _                                  ' KG081401
  1023.          GOTO 21625                                                  ' KG081401
  1024.       PROTO.PROMPT$ = WORK.ARA$(1)
  1025.       IF LEN(PROTO.PROMPT$) > 2 THEN _
  1026.          IF MID$(PROTO.PROMPT$,2,1) = ")" THEN _
  1027.             PROTO.PROMPT$ = LEFT$(PROTO.PROMPT$,1) + MID$(PROTO.PROMPT$,3)
  1028.       X = INSTR(PROTO.PROMPT$+CRLF$,CRLF$)
  1029.       PROTO.PROMPT$ = LEFT$(PROTO.PROMPT$,X-1)
  1030.       CALL TRIM (PROTO.PROMPT$)
  1031.       PROTO.METHOD$ = LEFT$(WORK.ARA$(3),1)
  1032.       CALL ALLCAPS (PROTO.METHOD$)
  1033.       REQ.8.BIT = (LEFT$(WORK.ARA$(4),1) = "8")
  1034.       DOWN.TEMPLATE$ = WORK.ARA$(12)
  1035.       UP.TEMPLATE$ = WORK.ARA$(13)
  1036.       X$ = WORK.ARA$(11)
  1037.       X = INSTR(X$,"=")
  1038.       ADVANCE.PROTO.WRITE = FALSE
  1039.       IF X < 2 OR X >= LEN(X$) THEN _
  1040.          FAILURE.PARM = 4 : _
  1041.          FAILURE.STRING$ = "F" _
  1042.       ELSE FAILURE.PARM = VAL(LEFT$(X$,X-1)) : _
  1043.            FAILURE.STRING$ = MID$(X$,X+1) : _
  1044.            X = INSTR(FAILURE.STRING$,"=") : _
  1045.            IF X > 0 THEN _
  1046.               ADVANCE.PROTO.WRITE = (MID$(FAILURE.STRING$,X) = "=A") : _
  1047.               FAILURE.STRING$ = LEFT$(FAILURE.STRING$,X-1)
  1048.       PROTO.MACRO$ = WORK.ARA$(10)
  1049.       FAKE.XRPT = (LEFT$(WORK.ARA$(8),1) = "F")
  1050.       BATCH.PROTO = (LEFT$(WORK.ARA$(6),1) = "B")
  1051.       SPEED.FACTOR! = VAL(WORK.ARA$(9))
  1052.       IF SPEED.FACTOR! < 0.1 THEN _
  1053.          SPEED.FACTOR! = 0.87
  1054.       BLOCK.SIZE = VAL(WORK.ARA$(7))
  1055.       FLEN = BLOCK.SIZE
  1056.       IF FLEN < 1 THEN _
  1057.          FLEN = 128
  1058. 21625 PREV.PROTO.PROMPT$ = PROTO.PROMPT$
  1059.       END SUB
  1060. 21993 ' $SUBTITLE: 'FILELOCK - subroutine to share RBBS-PC files'
  1061. ' $PAGE
  1062. '
  1063. '  NAME    -- FILELOCK
  1064. '
  1065. '  INPUTS  --     PARAMETER                    MEANING
  1066. '             SUBROUTINE.PARAMETER = 1 UNLOCK USERS AND MESSAGES
  1067. '                                    2 FLUSH MESSAGE RECORD TO DISK
  1068. '                                      AND UNLOCK MESSAGES
  1069. '                                    3 LOCK MESSAGE FILE
  1070. '                                    4 UNLOCK MESSAGE FILE
  1071. '                                    5 LOCK USER FILE
  1072. '                                    6 LOCK 4 RECORD BLOCK IN USER
  1073. '                                      FILE
  1074. '                                    7 UNLOCK USER FILE
  1075. '                                    8 UNLOCK 4 RECORD BLOCK IN USER
  1076. '                                      FILE
  1077. '                                    9 LOCK UPLOAD DIRECTORY OR
  1078. '                                      COMMENTS FILE
  1079. '                                   10 UNLOCK UPLOAD DIRECTORY OR
  1080. '                                      COMMENTS FILE
  1081. '               ACTIVE.MESSAGE FILE$   NAME OF MESSAGE FILE
  1082. '               ACTIVE.USER.FILE$      NAME OF USER FILE
  1083. '               CONFIG.FILE.NAME$      FILE NAME TO FLUSH RECORD FROM
  1084. '               EN$                    UPLOAD DIRECTORY OR COMMENTS
  1085. '                                      FILE NAME TO LOCK/UNLOCK
  1086. '               NETWORK.TYPE           TYPE OF NETWORK LOCKING TO USE
  1087. '
  1088. '  OUTPUTS -- SUBROUTINE.PARAMETER = -1 TERMINATE RBBS-PC IMMEDATELY
  1089. '             BLK
  1090. '             LOCK.DRIVE
  1091. '             LOCK.FILE.NAME$
  1092. '             LOCK.STATUS$
  1093. '             MESSAGE.FILE.LOCK
  1094. '             USER.BLOCK.LOCK
  1095. '             USER.FILE.LOCK
  1096. '             USER.FILE.INDEX
  1097. '
  1098. '  PURPOSE -- To lock and unlock the shared RBBS-PC files when
  1099. '             multiple copies of RBBS-PC are sharing the same
  1100. '             files in either a multi-tasking DOS environment or
  1101. '             in a local area network environment
  1102. '
  1103.       SUB FILELOCK STATIC
  1104.       ON SUBROUTINE.PARAMETER GOSUB 21995,21996,22000,25000,26000, _
  1105.                                     26500,27000,27500,29000,29500
  1106.       EXIT SUB
  1107. '
  1108. '
  1109. ' *  UNLOCK USERS AND MESSAGES
  1110. '
  1111. '
  1112. 21995 GOSUB 27000
  1113.       GOSUB 25000
  1114.       RETURN
  1115. '
  1116. '
  1117. ' *  FLUSH MESSAGE FILE DATA TO DISK BY OPENING DUMMY FILE # 1
  1118. '
  1119. '
  1120. 21996 CLOSE 1
  1121.       IF SHARE.IT THEN _
  1122.          OPEN CONFIG.FILENAME$ FOR INPUT SHARED AS #1 _
  1123.       ELSE OPEN "I",1,CONFIG.FILENAME$
  1124. '
  1125. '
  1126. ' *  UNLOCK MESSAGES
  1127. '
  1128. '
  1129.       GOSUB 25000
  1130.       CALL OPENMSG
  1131.       RETURN
  1132. '
  1133. '
  1134. ' *  LOCK MESSAGE FILE
  1135. '
  1136. '
  1137. 22000 IF MESSAGE.FILE.LOCK = TRUE THEN _
  1138.          RETURN
  1139.       MESSAGE.FILE.LOCK = TRUE
  1140.       MID$(LOCK.STATUS$,1,2) = "LM"
  1141.       SUBROUTINE.PARAMETER = 2
  1142.       CALL LINE25
  1143.       LOCK.FILE.NAME$ = ACTIVE.MESSAGE.FILE$
  1144.       ON NETWORK.TYPE GOTO 22100,22200,22300,22400,22500,29700
  1145.       RETURN
  1146. '
  1147. '
  1148. ' *  LOCK MESSAGE FILE (MULTI-LINK)
  1149. '
  1150. '
  1151. 22100 AX = &H0
  1152.       BX = &H1
  1153.       IF MULTI.LINK.PRESENT > 0 THEN _
  1154.          CALL RBBSML(AX,BX)
  1155.       RETURN
  1156. '
  1157. '
  1158. ' *  LOCK MESSAGE FILE (OMNINET)
  1159. '
  1160. '
  1161. 22200 CALL BRKFNAME (ACTIVE.MESSAGE.FILE$,DRV$,FPREFIX$,EXT$,FALSE)
  1162.       CC$ = CHR$(1) + _
  1163.             LEFT$(FPREFIX$ + SPACE$(8),8)
  1164.       GOSUB 28000
  1165.       IF CT = 0 THEN _
  1166.          RETURN
  1167.       CALL DELAYIT (1)
  1168.       GOTO 22200
  1169. '
  1170. '
  1171. ' *  LOCK MESSAGE FILE (ORCHID PC-NET)
  1172. ' *  LOCK USER FILE (ORCHID PC-NET)
  1173. ' *  LOCK UPLOAD DIRECTORY OR COMMENTS BASED ON EN$ (ORCHID PC-NET)
  1174. '
  1175. '
  1176. 22300 GOSUB 28100
  1177.       CALL LPLKIT(LOCK.DRIVE,LOCK.FILE.NAME$,A)
  1178.       RETURN
  1179. '
  1180. '
  1181. ' *  LOCK SYSTEM (DESQview)
  1182. '
  1183. '
  1184. 22400 CALL DVLOCK("MESSAGE")
  1185.       RETURN
  1186. '
  1187. '
  1188. ' *  LOCK MESSAGE FILE (10 NET)
  1189. ' *  LOCK USER FILE (10 NET)
  1190. ' *  LOCK UPLOAD DIRECTORY OR COMMENTS BASED ON EN$ (10 NET)
  1191. '
  1192. '
  1193. 22500 GOSUB 28100
  1194.       CALL LPLK10(LOCK.DRIVE,LOCK.FILE.NAME$,A)
  1195.       RETURN
  1196. '
  1197. '
  1198. ' *  UNLOCK MESSAGE FILE
  1199. '
  1200. '
  1201. 25000 IF NOT MESSAGE.FILE.LOCK THEN _
  1202.          RETURN
  1203.       MESSAGE.FILE.LOCK = FALSE
  1204.       MID$(LOCK.STATUS$,1,2) = "UM"
  1205.       SUBROUTINE.PARAMETER = 2
  1206.       CALL LINE25
  1207.       LOCK.FILE.NAME$ = ACTIVE.MESSAGE.FILE$
  1208.       ON NETWORK.TYPE GOTO 25100,25200,25300,25400,25500,29800
  1209.       RETURN
  1210. '
  1211. '
  1212. ' *  UNLOCK MESSAGE FILE (MULTI-LINK)
  1213. '
  1214. '
  1215. 25100 AX = &H100
  1216.       BX = &H1
  1217.       IF MULTI.LINK.PRESENT > 0 THEN _
  1218.          CALL RBBSML(AX,BX)
  1219.       RETURN
  1220. '
  1221. '
  1222. ' *  UNLOCK MESSAGE FILE (OMNINET)
  1223. '
  1224. '
  1225. 25200 CALL BRKFNAME (ACTIVE.MESSAGE.FILE$,DRV$,FPREFIX$,EXT$,FALSE)
  1226.       CC$ = CHR$(17) + _
  1227.             LEFT$(FPREFIX$ + SPACE$(8),8)
  1228.       GOSUB 28000
  1229.       IF CT = 128 THEN _
  1230.          RETURN
  1231.       CALL DELAYIT (1)
  1232.       GOTO 25200
  1233. '
  1234. '
  1235. ' *  UNLOCK MESSAGE FILE (ORCHID PC-NET)
  1236. ' *  UNLOCK USER FILE (ORCHID PC-NET)
  1237. ' *  UNLOCK UPLOAD DIRECTORY OR COMMENTS BASED ON EN$ (ORCHID PC-NET)
  1238. '
  1239. '
  1240. 25300 GOSUB 28100
  1241.       CALL UNLOKIT(LOCK.DRIVE,LOCK.FILE.NAME$,A)
  1242.       RETURN
  1243. '
  1244. '
  1245. ' *  UNLOCK MESSAGE FILE (DESQVIEW)
  1246. '
  1247. '
  1248. 25400 CALL DVUNLOCK("MESSAGE")
  1249.       RETURN
  1250. '
  1251. '
  1252. ' *  UNLOCK MESSAGE FILE (10 NET)
  1253. ' *  UNLOCK USER FILE (10 NET)
  1254. ' *  UNLOCK UPLOAD DIRECTORY OR COMMENTS BASED ON EN$ (10 NET)
  1255. '
  1256. '
  1257. 25500 GOSUB 28100
  1258.       CALL UNLOK10(LOCK.DRIVE,LOCK.FILE.NAME$,A)
  1259.       RETURN
  1260.  
  1261. '
  1262. '
  1263. ' *  LOCK USER FILE
  1264. '
  1265. '
  1266. 26000 IF USER.FILE.LOCK = TRUE THEN _
  1267.          RETURN
  1268.       USER.FILE.LOCK = TRUE
  1269.       MID$(LOCK.STATUS$,4,2) = "LU"
  1270.       SUBROUTINE.PARAMETER = 2
  1271.       CALL LINE25
  1272.       LOCK.FILE.NAME$ = ACTIVE.USER.FILE$
  1273.       ON NETWORK.TYPE GOTO 26100,26200,22300,26300,22500,29720
  1274.       RETURN
  1275. '
  1276. '
  1277. ' *  LOCK USER FILE (MULTI-LINK)
  1278. '
  1279. '
  1280. 26100 AX = &H0
  1281.       BX = &H2
  1282.       IF MULTI.LINK.PRESENT > 0 THEN _
  1283.          CALL RBBSML(AX,BX)
  1284.       RETURN
  1285. '
  1286. '
  1287. ' *  LOCK USER FILE (OMNINET)
  1288. '
  1289. '
  1290. 26200 CALL BRKFNAME (ACTIVE.USER.FILE$,DRV$,FPREFIX$,EXT$,FALSE)
  1291.       CC$ = CHR$(1) + _
  1292.             LEFT$(FPREFIX$ + SPACE$(8),8)
  1293.       GOSUB 28000
  1294.       IF CT = 0 THEN _
  1295.          RETURN
  1296.       CALL DELAYIT (1)
  1297.       GOTO 26200
  1298. '
  1299. '
  1300. ' *  LOCK USER FILE (DESQVIEW)
  1301. '
  1302. '
  1303. 26300 CALL DVLOCK("USER")
  1304.       RETURN
  1305. '
  1306. '
  1307. ' *  LOCK 4 RECORD BLOCK IN USER FILE
  1308. '
  1309. '
  1310. 26500 IF USER.BLOCK.LOCK = TRUE THEN _
  1311.          RETURN
  1312.       USER.BLOCK.LOCK = TRUE
  1313.       BLK = (USER.FILE.INDEX / 4) + .26
  1314.       MID$(LOCK.STATUS$,7,2) = "LB"
  1315.       SUBROUTINE.PARAMETER = 2
  1316.       CALL LINE25
  1317.       ON NETWORK.TYPE GOTO 26600,26700,26800,26750,26900,29730
  1318.       RETURN
  1319. '
  1320. '
  1321. ' *  LOCK 4 RECORD BLOCK IN USER FILE (MULTI-LINK)
  1322. '
  1323. '
  1324. 26600 AX = &H0
  1325.       BX = BLK + 10
  1326.       IF MULTI.LINK.PRESENT > 0 THEN _
  1327.          CALL RBBSML(AX,BX)
  1328.       RETURN
  1329. '
  1330. '
  1331. ' *  LOCK 4 RECORD BLOCK IN USER FILE (OMNINET)
  1332. '
  1333. '
  1334. 26700 CC$ = CHR$(1) + _
  1335.             "BLK" + _
  1336.             RIGHT$("0000" + MID$(STR$(BLK),2),5)
  1337.       GOSUB 28000
  1338.       IF CT = 0 THEN _
  1339.          RETURN
  1340.       CALL DELAYIT (1)
  1341.       GOTO 26700
  1342. '
  1343. '
  1344. ' *  LOCK 4 RECORD BLOCK IN USER FILE (DESKVIEW)
  1345. '
  1346. '
  1347. 26750 CALL DVLOCK("BLK" + RIGHT$("0000" + MID$(STR$(BLK),2),5))
  1348.       RETURN
  1349. '
  1350. '
  1351. ' *  LOCK 4 RECORD BLOCK IN USER FILE (ORCHID PC-NET)
  1352. '
  1353. '
  1354. 26800 LOCK.FILE.NAME$ = LEFT$(ACTIVE.USER.FILE$,2) + _
  1355.                         "BLK" + _
  1356.                         RIGHT$("0000" + MID$(STR$(BLK),2),5)
  1357.       GOTO 22300
  1358. '
  1359. '
  1360. ' *  LOCK 4 RECORD BLOCK IN USER FILE (10 NET)
  1361. '
  1362. '
  1363. 26900 LOCK.FILE.NAME$ = LEFT$(ACTIVE.USER.FILE$,2) + _
  1364.                         "BLK" + _
  1365.                         RIGHT$("0000" + MID$(STR$(BLK),2),5)
  1366.       GOTO 22500
  1367. '
  1368. '
  1369. ' *  UNLOCK USER FILE
  1370. '
  1371. '
  1372. 27000 IF NOT USER.FILE.LOCK THEN _
  1373.          RETURN
  1374.       USER.FILE.LOCK = FALSE
  1375.       MID$(LOCK.STATUS$,4,2) = "UU"
  1376.       SUBROUTINE.PARAMETER = 2
  1377.       CALL LINE25
  1378.       LOCK.FILE.NAME$ = ACTIVE.USER.FILE$
  1379.       ON NETWORK.TYPE GOTO 27100,27200,25300,27300,25500,29820
  1380.       RETURN
  1381. '
  1382. '
  1383. ' *  UNLOCK USER FILE (MULTI-LINK)
  1384. '
  1385. '
  1386. 27100 AX = &H100
  1387.       BX = &H2
  1388.       IF MULTI.LINK.PRESENT > 0 THEN _
  1389.          CALL RBBSML(AX,BX)
  1390.       RETURN
  1391. '
  1392. '
  1393. ' *  UNLOCK USER FILE (OMNINET)
  1394. '
  1395. '
  1396. 27200 CALL BRKFNAME (ACTIVE.USER.FILE$,DRV$,FPREFIX$,EXT$,FALSE)
  1397.       CC$ = CHR$(17) + _
  1398.             LEFT$(FPREFIX$ + SPACE$(8),8)
  1399.       GOSUB 28000
  1400.       IF CT = 128 THEN _
  1401.          RETURN
  1402.       CALL DELAYIT (1)
  1403.       GOTO 27200
  1404. '
  1405. '
  1406. ' *  UNLOCK USER FILE (DESQVIEW)
  1407. '
  1408. '
  1409. 27300 CALL DVUNLOCK("USER")
  1410.       RETURN
  1411. '
  1412. '
  1413. ' *  UNLOCK 4 RECORD BLOCK IN USER FILE
  1414. '
  1415. '
  1416. 27500 IF NOT USER.BLOCK.LOCK THEN _
  1417.          RETURN
  1418.       USER.BLOCK.LOCK = FALSE
  1419.       BLK = (USER.FILE.INDEX / 4) + .26
  1420.       MID$(LOCK.STATUS$,7,2) = "UB"
  1421.       SUBROUTINE.PARAMETER = 2
  1422.       CALL LINE25
  1423.       ON NETWORK.TYPE GOTO 27600,27700,27800,27750,27900,29830
  1424.       RETURN
  1425. '
  1426. '
  1427. ' *  UNLOCK 4 RECORD BLOCK IN USER FILE (MULTI-LINK)
  1428. '
  1429. '
  1430. 27600 AX = &H100
  1431.       BX = BLK + 10
  1432.       IF MULTI.LINK.PRESENT > 0 THEN _
  1433.          CALL RBBSML(AX,BX)
  1434.       RETURN
  1435. '
  1436. '
  1437. ' *  UNLOCK 4 RECORD BLOCK IN USER FILE (OMNINET)
  1438. '
  1439. '
  1440. 27700 CC$ = CHR$(17) + _
  1441.             "BLK" + _
  1442.             RIGHT$("0000" + MID$(STR$(BLK),2),5)
  1443.       GOSUB 28000
  1444.       IF CT = 128 THEN _
  1445.          RETURN
  1446.       CALL DELAYIT (1)
  1447.       GOTO 27700
  1448. '
  1449. '
  1450. ' *  UNLOCK 4 RECORD BLOCK IN USER FILE (DESQVIEW)
  1451. '
  1452. '
  1453. 27750 CALL DVUNLOCK("BLK" + RIGHT$("0000" + MID$(STR$(BLK),2),5))
  1454.       RETURN
  1455. '
  1456. '
  1457. ' *  UNLOCK 4 RECORD BLOCK IN USER FILE (ORCHID PC-NET)
  1458. '
  1459. '
  1460. 27800 LOCK.FILE.NAME$ = LEFT$(ACTIVE.USER.FILE$,2) + _
  1461.                         "BLK" + _
  1462.                         RIGHT$("0000" + MID$(STR$(BLK),2),5)
  1463.       GOTO 25300
  1464. '
  1465. '
  1466. ' *  UNLOCK 4 RECORD BLOCK IN USER FILE (10-NET)
  1467. '
  1468. '
  1469. 27900 LOCK.FILE.NAME$ = LEFT$(ACTIVE.USER.FILE$,2) + _
  1470.                         "BLK" + _
  1471.                         RIGHT$("0000" + MID$(STR$(BLK),2),5)
  1472.       GOTO 25500
  1473. '
  1474. '
  1475. ' *  CORVUS OMNINET INTERFACE
  1476. '
  1477. '
  1478. 28000 CC$ = LINE.FEED$ + _
  1479.             CHR$(0) + _
  1480.             CHR$(11) + _
  1481.             CC$
  1482.       CALL CDSEND(CC$)
  1483.       CALL CDRECV(CN$)
  1484.       CT = ASC(MID$(CN$,3,1))
  1485.       IF CT => 128 THEN _
  1486.          CALL LPRNT("CORVUS LOCK FAIL",1) : _
  1487.          SUBROUTINE.PARAMETER = -1
  1488. 28010 CT = ASC(MID$(CN$,4,1))
  1489.       IF CT => 129 THEN _
  1490.          CALL LPRNT("CORVUS FULL",1) : _
  1491.          SUBROUTINE.PARAMETER = -1
  1492.       RETURN
  1493. '
  1494. '
  1495. ' *  ORCHID PC-NET & 10 NET INTERFACE
  1496. '
  1497. '
  1498. 28100 CALL ALLCAPS (LOCK.FILE.NAME$)
  1499.       LOCK.DRIVE = ASC(LEFT$(LOCK.FILE.NAME$,1)) - ASC("A")
  1500.       LOCK.FILE.NAME$ = LOCK.FILE.NAME$ + _
  1501.                         STRING$(32 - LEN(LOCK.FILE.NAME$),0)
  1502.       A = 0
  1503.       RETURN
  1504. '
  1505. '
  1506. ' *  LOCK UPLOAD DIRECTORY OR COMMENTS BASED ON EN$
  1507. '
  1508. '
  1509. 29000 IF LOCKED.EN$ = EN$ THEN _
  1510.          RETURN
  1511.       LOCKED.EN$ = EN$
  1512.       MID$(LOCK.STATUS$,10,2) = "LD"
  1513.       SUBROUTINE.PARAMETER = 2
  1514.       CALL LINE25
  1515.       LOCK.FILE.NAME$ = EN$
  1516.       ON NETWORK.TYPE GOTO 29100,29010,22300,29300,22500,29710
  1517. 29010 RETURN
  1518. '
  1519. '
  1520. ' *  LOCK UPLOAD DIRECTORY OR COMMENTS BASED ON EN$ (MULTI-LINK)
  1521. '
  1522. '
  1523. 29100 AX = &H0
  1524.       BX = &H3
  1525.       IF MULTI.LINK.PRESENT > 0 THEN _
  1526.          CALL RBBSML(AX,BX)
  1527.       RETURN
  1528. '
  1529. '
  1530. ' *  LOCK UPLOAD DIRECTORY AND COMMENTS (DESQVIEW)
  1531. '
  1532. '
  1533. 29300 CALL DVLOCK("MISC")
  1534.       RETURN
  1535. '
  1536. '
  1537. ' *  UNLOCK UPLOAD DIRECTORY OR COMMENTS BASED ON EN$
  1538. '
  1539. '
  1540. 29500 IF LOCKED.EN$ <> EN$ THEN _
  1541.          RETURN
  1542.       LOCKED.EN$ = ""
  1543.       MID$(LOCK.STATUS$,10,2) = "UD"
  1544.       SUBROUTINE.PARAMETER = 2
  1545.       CALL LINE25
  1546.       LOCK.FILE.NAME$ = EN$
  1547.       ON NETWORK.TYPE GOTO 29600,29510,25300,29650,25500,29810
  1548. 29510 RETURN
  1549. '
  1550. '
  1551. ' *  UNLOCK UPLOAD DIRECTORY OR COMMENTS BASED ON EN$ (MULTI-LINK)
  1552. '
  1553. '
  1554. 29600 AX = &H100
  1555.       BX = &H3
  1556.       IF MULTI.LINK.PRESENT > 0 THEN _
  1557.          CALL RBBSML(AX,BX)
  1558.       EXIT SUB
  1559. '
  1560. '
  1561. ' *  UNLOCK UPLOAD DIRECTORY AND COMMENTS (DESQVIEW)
  1562. '
  1563. '
  1564. 29650 CALL DVUNLOCK("MISC")
  1565.       RETURN
  1566. '
  1567. '
  1568. ' *  NETBIOS SEMAPHORE LOCK MECHANISM
  1569. ' *     Only the USERS file is actually locked.  All other files are locked
  1570. ' *     by means of the semaphore file IBMFLAGS.  Each IBMFLAGS record is a
  1571. ' *     file semaphore as follows:
  1572. ' *        RECORD 1 = MESSAGES file lock status
  1573. ' *        RECORD 2 = Comments/Upload dir locked
  1574. ' *        RECORD 3 = entire USERS file lock
  1575. '
  1576. '
  1577. ' * Lock MESSAGES
  1578. 29700 CALL NETBIOS (1,6,1)
  1579.       RETURN
  1580.  
  1581. ' * Lock Comments/Upload dir
  1582. 29710 CALL NETBIOS (1,6,2)
  1583.       RETURN
  1584.  
  1585. ' * Lock USERS file
  1586. 29720 CALL NETBIOS (1,6,3)
  1587.       RETURN
  1588.  
  1589. ' * Lock single USERS record
  1590. 29730 CALL NETBIOS (1,6,3)
  1591.       RETURN
  1592.  
  1593. ' * UNLOCK MESSAGES
  1594. 29800 CALL NETBIOS (0,6,1)
  1595.       RETURN
  1596.  
  1597. ' * UNLOCK Comments/Upload dir
  1598. 29810 CALL NETBIOS (0,6,2)
  1599.       RETURN
  1600.  
  1601. ' * UNLOCK USERS file
  1602. 29820 CALL NETBIOS (0,6,3)
  1603.       RETURN
  1604.  
  1605. ' * UNLOCK single USERS record
  1606. 29830 CALL NETBIOS (0,6,3)
  1607.       RETURN
  1608.       END SUB
  1609. 30000 ' $SUBTITLE: 'INITIBM - sub to create/open NETBIOS semaphore file'
  1610. ' $PAGE
  1611. '
  1612. '  NAME    -- INITIBM   (Written by Doug Azzarito)
  1613. '
  1614. '  INPUTS  -- NONE
  1615. '
  1616. '  OUTPUTS -- SUBROUTINE.PARAMETER = -1   ABORT RBBS
  1617. '
  1618. '  PURPOSE -- Open semaphore file "IBMFLAGS" on default drive as file #6
  1619. '             Create file if it does not exits.
  1620. '
  1621.       SUB INITIBM STATIC
  1622. '
  1623. '
  1624. ' *  SEE IF FILE EXISTS
  1625. '
  1626. '
  1627.       SHARE.IT = TRUE
  1628.       FOR I = LEN(MAIN.MESSAGE.FILE$) TO 0 STEP -1
  1629.          IF I = 0 THEN _
  1630.             GOTO 30010
  1631.          IF MID$(MAIN.MESSAGE.FILE$,I,1) = ":" OR _
  1632.             MID$(MAIN.MESSAGE.FILE$,I,1) = "\" THEN _
  1633.             GOTO 30010
  1634.       NEXT
  1635. 30010 IBM.FLAG.FILE$ = LEFT$(MAIN.MESSAGE.FILE$,I) + _
  1636.                        "IBMFLAGS"
  1637.       CALL FINDIT (IBM.FLAG.FILE$)
  1638.       CLOSE 2
  1639.       IF OK THEN _
  1640.          GOTO 30020
  1641. '
  1642. '
  1643. ' *  CREATE A NEW FILE, EACH RECORD IS A SEMAPHORE
  1644. '
  1645. '
  1646.       OPEN IBM.FLAG.FILE$ ACCESS WRITE AS #6 LEN=2
  1647.       FIELD 6, 2 AS LOCKBUF$
  1648.       LSET LOCKBUF$ = MKI$(0)
  1649.       FOR I = 1 TO 3
  1650.          PUT 6
  1651.       NEXT
  1652.       CLOSE #6
  1653. 30020 OPEN IBM.FLAG.FILE$ ACCESS READ WRITE SHARED AS #6 LEN=2
  1654.       END SUB
  1655. 30500 ' $SUBTITLE: 'OPENMSG - open the MESSAGES file'
  1656. ' $PAGE
  1657. '
  1658. '  NAME    -- OPENMSG
  1659. '
  1660. '  INPUTS  --     PARAMETER                    MEANING
  1661. '              ACTIVE.MESSAGE.FILE$
  1662. '              SHARE.IT
  1663. '
  1664. '  OUTPUTS --  MESSAGE.RECORD$
  1665. '
  1666.       SUB OPENMSG STATIC
  1667. '
  1668. '
  1669. ' *  OPEN AND DEFINE MESSAGE FILE
  1670. '
  1671. '
  1672.      CLOSE 1
  1673.       IF SHARE.IT THEN _
  1674.          OPEN ACTIVE.MESSAGE.FILE$ ACCESS READ WRITE SHARED AS #1 _
  1675.       ELSE OPEN "R",1,ACTIVE.MESSAGE.FILE$
  1676.       FIELD 1,128 AS MESSAGE.RECORD$
  1677.       END SUB
  1678. 30595 ' $SUBTITLE: 'FINDFUNC - sub to handle local keyboard functions'
  1679. ' $PAGE
  1680. '
  1681. '  NAME    -- FINDFUNC
  1682. '
  1683. '  INPUTS  --  PARAMETER                 MEANING
  1684. '             ACTIVE.MENU$              INDICATOR OF ACTIVE MENU
  1685. '             ADJUSTED.SECURITY         SWITCH INDICATING TEMP. SECURITY CHANGE
  1686. '             AUTODOWNLOAD.DESIRED      USER'S PREFERENCE FOR AUTODOWNLOADING
  1687. '             CALLERS.FILE$             NAME OF CALLERS FILE
  1688. '             CHAT.AVAILABLE            TOGGLE INDICATING IF SYSOP WILL CHAT
  1689. '             CHECK.BULLETIN.LOGON      USER'S PREFERENCE FOR BULLETIN CHECK
  1690. '             CONFERENCE.MODE           INDICATOR THAT USER IS IN A CONFERENCE
  1691. '             CURSOR.LINE               LINE THAT THE CURSOR IS AT
  1692. '             CURSOR.ROW                ROW THAT THE CURSOR IS AT
  1693. '             DISK.FOR.DOS$             DISK TO LOAD COMMAND.COM FROM
  1694. '             DISKFULL.GO.OFFLINE       INDICATOR OF WHAT TO DO WHEN DISK FULL
  1695. '             EXIT.TO.DOORS             FLAG INDICATING EXITING TO DOORS
  1696. '             EXPERT.USER               FLAG FOR EXPERT/NOVICE USER MODE
  1697. '             FIRST.NAME$               LOGGED ON USER'S FIRST NAME
  1698. '             F1.KEY                    FUNCTION KEY ONE VALUE
  1699. '             F10.KEY                   FUNCTION KEY TEN VALUE
  1700. '             GR                        GRAPHICS PREFERENCE OF USER
  1701. '             LINE.FEEDS                SWTICH FOR USER'S LINE FEED PREFERENCE
  1702. '             LOCAL.USER                FLAG INDICATING USER IS LOCAL
  1703. '             MINIMUM.LOGON.SECURITY    MINIMUM SECURITY TO LOGON
  1704. '             MODEM.GO.OFFHOOK.COMMAND$ COMMAND TO TAKE MODEM OFF-HOOK
  1705. '             MODEM.INIT.BAUD$          BAUD TO INITIALIZE MODEM AT
  1706. '             NODE.ID$                  NODE IDENTIFIER
  1707. '             NODE.RECORD.INDEX         NODE RECORD INDEX FOR THIS NODE
  1708. '             NULLS                     SWITCH FOR USER'S PREFERENCE FOR NULLS
  1709. '             PRINTER                   TOGGLE INDICATING PRINTER IS AVAILABLE
  1710. '             PROMPT.BELL               USER'S PREFERENCE FOR BELLS ON PROMPTS
  1711. '             SECONDS.PER.SESSION       TIME LEFT IN CURRENT USER SESSION 
  1712. '             SKIP.FILES.LOGON          USER'S LOGON NOTIFICIATION PREFERENCE
  1713. '             SNOOP                     TOGGLE INDICATING SNOOP STATUS
  1714. '             SUBROUTINE.PARAMETER      -8  = SYSOP'S OPTION 6 REMOTELY
  1715. '                                       -9  = GOT TO DOS
  1716. '                                       -10 = SYSOP GET'S SYSTEM NEXT
  1717. '             SYSOP                     INDICATOR THAT USER IS SYSOP
  1718. '             SYSOP.ANNOY               TOGGLE INDICATING SYSOP IS AVAILABLE
  1719. '             SYSOP.NEXT                TOGGLE SO SYSOP GETS SYSTEM NEXT
  1720. '             UPPER.CASE                USER'S PREFERENCE FOR UPPER/LOWER CASE
  1721. '             USER.FILE.INDEX           INDEX INTO THE USER FILE FOR CALLER
  1722. '             USER.SECURITY.LEVEL       USER'S SECURITY LEVEL
  1723. '             USERT.TRANSFER.DEFAULT    USER'S FILE TRANSFER DEFAULT PREFERENCE
  1724. '
  1725. '  OUTPUTS --
  1726. '             ADJUSTED.SECURITY        SWITCH INDICATING TEMP. SECURITY CHANGE
  1727. '             CHAT.AVAILABLE           TOGGLE INDICATING IF SYSOP WILL CHAT
  1728. '             FUNCTION.KEY             VALUE 1 TO 10 CORRESPONDING TO
  1729. '                                      THE FUNCTION KEY THAT WAS PRESSED
  1730. '             KEY.PRESSED$             CHARACTER STRING GENERATED BY KEY
  1731. '             PRINTER                  TOGGEL INDICATING PRINTER IS AVAILABLE
  1732. '             SNOOP                    TOGGLE INDICATING SNOOP STATUS
  1733. '             SYSOP                    INDICATOR THAT USER IS SYSOP
  1734. '             SYSOP.ANNOY              TOGGLE INDICATING SYSOP IS AVAILABLE
  1735. '             SYSOP.NEXT               TOGGLE SO SYSOP GETS SYSTEM NEXT
  1736. '             SUBROUTINE.PARAMETER     -1 CARRIER LOST
  1737. '                                      -2 CHAT MODE ACTIVATED
  1738. '                                      -3 FORCE CALLER ON-LINE
  1739. '                                      -4 EXIT TO SYSTEM IMMEDIATELY
  1740. '                                      -5 EXIT TO SYSTEM AFTER MULTI-LINK CALL
  1741. '                                      -6 TELL USER ACCESS IS DENIED
  1742. '                                      -7 UPDATE CALLERS FILE AND DENY ACCESS
  1743. '             USER.SECURITY.LEVEL      USER'S SECURITY LEVEL
  1744. '
  1745. '  PURPOSE -- To determine if a function has been pressed on
  1746. '             the PC'S keyboard that is running RBBS-PC.
  1747. '
  1748.       SUB FINDFUNC STATIC
  1749.       LOOKUP = SUBROUTINE.PARAMETER
  1750.       IF SUBROUTINE.PARAMETER < -1 THEN _
  1751.          SUBROUTINE.PARAMETER = 0 : _
  1752.          IF LOOKUP = - 8 THEN _
  1753.             GOTO 33070 _
  1754.          ELSE IF LOOKUP = - 9 THEN _
  1755.                  GOTO 31000 _
  1756.               ELSE IF LOOKUP = - 10 THEN _
  1757.                       GOTO 33090
  1758. '
  1759. '
  1760. ' *  TEST FOR FUNCTION KEY PRESSED
  1761. '
  1762. '
  1763. 30600 IF KEYBOARD.STACK$ = "" THEN _
  1764.          KEY.PRESSED$ = INKEY$ _
  1765.       ELSE KEY.PRESSED$ = KEYBOARD.STACK$ : _
  1766.            KEYBOARD.STACK$ = ""
  1767.       FUNCTION.KEY = 0
  1768.       IF LEN(KEY.PRESSED$) <> 2 THEN _
  1769.          GOTO 33970
  1770.       KEY.PRESSED = ASC(RIGHT$(KEY.PRESSED$,1))
  1771. '      IF LOCAL.USER AND NOT SYSOP THEN _                             ' RIP OFF
  1772. '         KEY.PRESSED$ = "" : _
  1773. '         GOTO 33970
  1774.       IF KEY.PRESSED => F1.KEY AND _
  1775.          KEY.PRESSED <= F10.KEY THEN _
  1776.              FUNCTION.KEY = KEY.PRESSED - 58 : _
  1777.              GOTO 30610
  1778.       IF KEY.PRESSED = 117 THEN _    'Ctrl-End
  1779.          FUNCTION.KEY = 11
  1780.       IF KEY.PRESSED = 73 THEN _     'PgUp
  1781.          FUNCTION.KEY = 12
  1782.       IF KEY.PRESSED = 72 THEN _     'up arrow
  1783.          FUNCTION.KEY = 13
  1784.       IF KEY.PRESSED = 80 THEN _     'Down arrow
  1785.          FUNCTION.KEY = 14
  1786.       IF KEY.PRESSED = 81 THEN _     'PgDn
  1787.          FUNCTION.KEY = 15
  1788.       IF KEY.PRESSED = 75 THEN _     'left arrow
  1789.          FUNCTION.KEY = 16
  1790.       IF KEY.PRESSED = 77 THEN _     'Right arrow
  1791.          FUNCTION.KEY = 17
  1792.       IF KEY.PRESSED = 141 THEN _    'CTRL-up arrow
  1793.          FUNCTION.KEY = 18
  1794.       IF KEY.PRESSED = 132 THEN _    'CTRL-PgUp (same as CTRL-UP)
  1795.          FUNCTION.KEY = 18
  1796.       IF KEY.PRESSED = 145 THEN _    'CTRL-down arrow
  1797.          FUNCTION.KEY = 19
  1798.       IF KEY.PRESSED = 118 THEN _    'CTRL-PgDn (same as CTRL-DOWN)
  1799.          FUNCTION.KEY = 19
  1800.       IF KEY.PRESSED = 115 THEN _    'CTRL-left arrow
  1801.          FUNCTION.KEY = 20
  1802.       IF KEY.PRESSED = 116 THEN _    'CTRL-right arrow
  1803.          FUNCTION.KEY = 21
  1804. 30610 KEY.PRESSED$ = ""
  1805.       IF FUNCTION.KEY < 1 OR FUNCTION.KEY > 21 THEN _
  1806.          GOTO 33970
  1807.       IF FUNCTION.KEY < 10 AND (FUNCTION.KEY <> 8) THEN _
  1808.          GOTO 30620
  1809.       IF TOGGLE.ONLY THEN _
  1810.          SUBROUTINE.PARAMETER = 1 : _
  1811.          GOTO 33970
  1812. 30620 ON FUNCTION.KEY GOTO  31000, _            '  1 =  F1
  1813.                             32000, _            '  2 =  F2
  1814.                             33000, _            '  3 =  F3
  1815.                             33040, _            '  4 =  F4
  1816.                             33060, _            '  5 =  F5
  1817.                             33070, _            '  6 =  F6
  1818.                             33090, _            '  7 =  F7
  1819.                             33110, _            '  8 =  F8
  1820.                             33130, _            '  9 =  F9
  1821.                             33150, _            ' 10 = F10
  1822.                             31398, _            ' 11 = CTRL END
  1823.                             33200, _            ' 12 = PGUP
  1824.                             33170, _            ' 13 = UP ARROW
  1825.                             33180, _            ' 14 = DOWN ARROW
  1826.                             33220, _            ' 15 = PGDN
  1827.                             33240, _            ' 16 = LEFT ARROW
  1828.                             33250, _            ' 17 = RIGHT ARROW
  1829.                             33170, _            ' 18 = CTRL-UP ARROW
  1830.                             33180, _            ' 19 = CTRL-DOWN
  1831.                             33245, _            ' 20 = CTRL-LEFT
  1832.                             33255               ' 21 = CTRL-RIGHT
  1833. '
  1834. '
  1835. ' * F1 - COMMAND FROM LOCAL KEYBOARD (IMMEDIATE EXIT TO DOS)
  1836. '
  1837. '
  1838. 31000 SUBROUTINE.PARAMETER = -10
  1839.       CALL CARRIER
  1840.       IF SUBROUTINE.PARAMETER = 0 THEN _
  1841.          GOTO 33970
  1842.       CALL BRKFNAME(CALLERS.FILE$,X$,Y$,Z$,TRUE)
  1843.       FILE.NAME$ = X$ + "RBBS" + NODE.FILE.ID$ + "F1.DEF"
  1844.       CLOSE 2
  1845.       CALL OPENOUTW (FILE.NAME$)
  1846.       PRINT #2,MID$(FILE.NAME$,3,7)
  1847.       IF EXIT.TO.DOORS THEN _
  1848.          SUBROUTINE.PARAMETER = -4 : _
  1849.          GOTO 33970
  1850.       CALL OPENCOM(MODEM.INIT.BAUD$,",N,8,1")
  1851.       CALL MODEMPUT (MODEM.GO.OFFHOOK.COMMAND$)
  1852.       CALL DELAYIT (2)
  1853.       SUBROUTINE.PARAMETER = -5
  1854.       GOTO 33970
  1855. '
  1856. '
  1857. ' *  END KEY - FORCE CURRENT USER OFF AND LOCK THEM OUT
  1858. '
  1859. '
  1860. 31398 IF NOT LOCAL.USER THEN _
  1861.          CALL CARRIER : _
  1862.          IF SUBROUTINE.PARAMETER = -1 THEN _
  1863.             GOTO 33970
  1864.       FUNCTION.KEY = 0
  1865.       IF INSTR("MUF",ACTIVE.MENU$) > 0 THEN _
  1866.          GOTO 31399
  1867.       CURSOR.LINE = CSRLIN
  1868.       CURSOR.ROW = POS(0)
  1869.       LOCATE 25,1
  1870.       D$ = SPACE$(79)
  1871.       GOSUB 33210
  1872.       LOCATE 25,1
  1873.       D$ ="Cannot FORCE OFF until user reaches MAIN menu"
  1874.       GOSUB 33210
  1875.       CALL DELAYIT (1)
  1876.       LOCATE CURSOR.LINE,CURSOR.ROW
  1877.       SUBROUTINE.PARAMETER = 1
  1878.       CALL LINE25
  1879.       GOTO 33970
  1880. 31399 CALL QTPUT1 (FIRST.NAME$ + ", goodbye and don't call back")
  1881.       IF USER.FILE.INDEX < 1 THEN _
  1882.          SUBROUTINE.PARAMETER = -6 : _
  1883.          GOTO 33970
  1884.       USER.SECURITY.LEVEL = MINIMUM.LOGON.SECURITY - 1
  1885.       CALL DENYACCESS
  1886.       SUBROUTINE.PARAMETER = -7
  1887.       GOTO 33970
  1888. '
  1889. '
  1890. ' * F2 - COMMAND FROM LOCAL KEYBOARD (SYSOP EXIT TO DOS AND RETURN)
  1891. '
  1892. '
  1893.  
  1894. 32000 IF NOT LOCAL.USER THEN _
  1895.          CALL SKIPLINE (1) : _
  1896.          CALL QTPUT1 ("Sysop exiting to DOS. Please wait...") : _
  1897.          FUNCTION.KEY = 0 : _
  1898.          CALL DELAYIT (3)
  1899.       CALL SHELLEXIT (DISK.FOR.DOS$ + "COMMAND")                     ' KG052802
  1900.       'SHELL DISK.FOR.DOS$ + _
  1901.       '      "COMMAND"
  1902.       CLS
  1903.       IF NOT LOCAL.USER THEN _
  1904.          CALL CARRIER : _
  1905.          IF SUBROUTINE.PARAMETER = -1 THEN _
  1906.             GOTO 33970
  1907.       SUBROUTINE.PARAMETER = 2
  1908.       CALL LINE25
  1909.       CALL QTPUT1 ("Sysop back from DOS.  Returning control to you.")
  1910.       COMMPORT.STACK$ = CARRIAGE.RETURN$
  1911.       GOTO 33970
  1912. '
  1913. '
  1914. ' * F3 - COMMAND FROM LOCAL KEYBOARD (PRINTER TOGGLE)
  1915. '
  1916. '
  1917. 33000 PRINTER = NOT PRINTER
  1918.       CHANGE.VALUE = PRINTER
  1919.       FIELD.POSITION = 38
  1920.       GOTO 33950
  1921. '
  1922. '
  1923. ' * F4 - COMMAND FROM LOCAL KEYBOARD (SYSOP ANNOY)
  1924. '
  1925. '
  1926. 33040 SYSOP.ANNOY = NOT SYSOP.ANNOY
  1927.       CHANGE.VALUE = SYSOP.ANNOY
  1928.       FIELD.POSITION = 34
  1929.       GOTO 33950
  1930. '
  1931. '
  1932. ' * F5 - COMMAND FROM LOCAL KEYBOARD (FORCE CALLER ONLINE)
  1933. '
  1934. '
  1935. 33060 FUNCTION.KEY = 0
  1936.       SUBROUTINE.PARAMETER = -3
  1937.       GOTO 33970
  1938. '
  1939. '
  1940. ' * F6 - COMMAND FROM LOCAL KEYBOARD (SYSOP AVAILABLE TOGGLE)
  1941. ' *  6 - COMMAND FROM SYSOP MENU (SYSOP AVAILABLE TOGGLE)
  1942. '
  1943. '
  1944. 33070 SYSOP.AVAILABLE = NOT SYSOP.AVAILABLE
  1945.       CHANGE.VALUE = SYSOP.AVAILABLE
  1946.       FIELD.POSITION = 32
  1947.       GOTO 33950
  1948. '
  1949. '
  1950. ' * F7 - COMMAND FROM LOCAL KEYBOARD (SYSOP GETS SYSTEM NEXT)
  1951. '
  1952. '
  1953. 33090 IF ERR=61 AND NOT DISKFULL.GO.OFFLINE THEN _
  1954.          GOTO 33970
  1955.       SYSOP.NEXT = NOT SYSOP.NEXT
  1956.       CHANGE.VALUE = SYSOP.NEXT
  1957.       FIELD.POSITION = 36
  1958.       GOTO 33950
  1959. '
  1960. '
  1961. ' * F8 - COMMAND FROM LOCAL KEYBOARD (ASSIGN USER TEMPORARY SYSOP SECURITY)
  1962. '
  1963. '
  1964. 33110 SYSOP = NOT SYSOP
  1965.       CURSOR.LINE = CSRLIN
  1966.       CURSOR.ROW = POS(0)
  1967.       LOCATE 25,1
  1968.       D$ = SPACE$(79)
  1969.       NUM.RETURNS = 0
  1970.       CALL LPRNT (D$,NUM.RETURNS)
  1971.       LOCATE 25,1
  1972.       USER.SECURITY.LEVEL = (1 + SYSOP) * _
  1973.                             USER.SECURITY.SAVE  - _
  1974.                             SYSOP * _
  1975.                             SYSOP.SECURITY.LEVEL
  1976.       D$ = "SYSOP Privileges " + FNOFFON$(SYSOP)
  1977.       CALL LPRNT (D$,NUM.RETURNS)
  1978.       CALL DELAYIT (3)
  1979.       LOCATE CURSOR.LINE,CURSOR.ROW
  1980.       SUBROUTINE.PARAMETER = 1
  1981.       CALL LINE25
  1982.       CALL CALLOPT
  1983.       GOTO 33970
  1984. '
  1985. '
  1986. ' * F9 - COMMAND FROM LOCAL KEYBOARD (SNOOP TOGGLE)
  1987. '
  1988. '
  1989. 33130 IF NOT SNOOP THEN _
  1990.          SNOOP = TRUE : _
  1991.          LOCATE 24,1,0 : _
  1992.          D$ = "SNOOP ON" : _
  1993.          NUM.RETURNS = 0 : _
  1994.          CALL LPRNT (D$,NUM.RETURNS) : _
  1995.          SUBROUTINE.PARAMETER = 2 : _
  1996.          CALL LINE25 _
  1997.       ELSE LOCATE ,,0 : _
  1998.            SNOOP = FALSE : _
  1999.            CLS
  2000. 33140 CHANGE.VALUE = SNOOP
  2001.       FIELD.POSITION = 58
  2002.       GOTO 33950
  2003. '
  2004. '
  2005. ' * F10 - COMMAND FROM LOCAL KEYBOARD (FORCE CHAT WITH USER)
  2006. '
  2007. '
  2008. 33150 GOTO 33160
  2009. 33155 SUBROUTINE.PARAMETER = 1
  2010.       CALL LINE25
  2011.       GOTO 33970
  2012. 33160 CALL UPDTCALR ("Sysop began chat",1)
  2013.       PAGE.STATUS$ = ""
  2014.       CALL SKIPLINE (1)
  2015.       CALL QTPUT1 ("Hi " + _
  2016.            FIRST.NAME$ + _
  2017.            ", this is " + _
  2018.            SYSOP.FIRST.NAME$ + _
  2019.            " " + _
  2020.            SYSOP.LAST.NAME$ + _
  2021.            "  Sorry to break in to CHAT but..")
  2022.       CALL TIMEBACK (1)                                              ' KG082701
  2023.       CALL SYSOPCHAT
  2024.       CALL TIMEBACK (2)                                              ' KG082701
  2025.       COMMPORT.STACK$ = CHR$(13)
  2026.       GOTO 33155
  2027. '
  2028. '
  2029. ' * UP / CTRL-UP: INCREASE THE ON-LINE USER'S SECURITY BY ONE / FIVE
  2030. '
  2031. '
  2032. 33170 USER.SECURITY.LEVEL = USER.SECURITY.LEVEL + _
  2033.                             1 - 4 * (FUNCTION.KEY = 18)
  2034.       GOTO 33190
  2035. '
  2036. '
  2037. ' * DOWN / CTRL-DOWN: DECREASE THE ON-LINE USER'S SECURITY BY ONE / FIVE
  2038. '
  2039. '
  2040. 33180 USER.SECURITY.LEVEL = USER.SECURITY.LEVEL - _
  2041.                             1 + 4 * (FUNCTION.KEY = 19)
  2042. 33190 ADJUSTED.SECURITY = TRUE
  2043.       USER.SECURITY.SAVE = USER.SECURITY.LEVEL
  2044.       IF (NOT CONFERENCE.MODE) AND (NOT SUB.BOARD) THEN _            ' KG052104
  2045.          ORIG.SECURITY = USER.SECURITY.LEVEL : _                     ' KG052104
  2046.       SUBROUTINE.PARAMETER = 2
  2047.       CALL LINE25
  2048.       CALL CALLOPT
  2049.       GOTO 33970
  2050. '
  2051. '
  2052. ' * PGUP DISPLAY USER PROFILE
  2053. '
  2054. '
  2055. 33200 IF NOT LOCAL.USER THEN _
  2056.          CALL CARRIER : _
  2057.          IF SUBROUTINE.PARAMETER = -1 THEN _
  2058.             GOTO 33970
  2059.       IF VOICE.TYPE <> 0 THEN _
  2060.          TALK.ALL = TRUE
  2061.       CALL PAGEUP
  2062.       D$ = MID$("NoviceExPERT",1 -6 * EXPERT.USER,6)
  2063.       GOSUB 33210
  2064.       D$ = "GRAPHICS: " + _
  2065.            MID$("None AsciiColor",GR * 5 + 1,5)
  2066.       GOSUB 33210
  2067.       D$ = "PROTOCOL : " + _
  2068.            USER.TRANSFER.DEFAULT$
  2069.       GOSUB 33210
  2070.       D$ = "UPPER CASE " + _
  2071.            MID$("and lowerONLY", 1 - 9 * UPPER.CASE,9)
  2072.       GOSUB 33210
  2073.       D$ = "Line Feeds " + FNOFFON$(LINE.FEEDS)
  2074.       GOSUB 33210
  2075.       D$ = "Nulls " + FNOFFON$(NULLS)
  2076.       GOSUB 33210
  2077.       D$ = "Prompt Bell " + FNOFFON$(PROMPT.BELL)
  2078.       GOSUB 33210
  2079.       D$ = MID$("SKIP CHECK",1 -5 * CHECK.BULLETIN.LOGON,5) + _
  2080.            " old BULLETINS on logon."
  2081.       GOSUB 33210
  2082.       D$ = MID$("CHECKSKIP ",1 -5 * SKIP.FILES.LOGON,5) + _
  2083.            " new files on logon."
  2084.       GOSUB 33210
  2085.       D$ = "Autodownload " + FNOFFON$(AUTODOWNLOAD.DESIRED)
  2086.       GOSUB 33210
  2087.       TALK.ALL = FALSE
  2088.       GOTO 33970
  2089. 33210 NUM.RETURNS = 1
  2090.       CALL LPRNT(D$,NUM.RETURNS)
  2091.       RETURN
  2092. '
  2093. '
  2094. ' * PGDN CLEAR DISPLAY OF USER'S PROFILE
  2095. '
  2096. '
  2097. 33220 IF NOT LOCAL.USER THEN _
  2098.          CALL CARRIER : _
  2099.          IF SUBROUTINE.PARAMETER = -1 THEN _
  2100.             GOTO 33970
  2101.       CLS
  2102.       GOTO 33155
  2103. '
  2104. '
  2105. ' * LEFT ARROW - DECREASE THE ON-LINE USER'S TIME BY ONE MINUTE
  2106. '
  2107. '
  2108. 33240 IF SECONDS.PER.SESSION! > 120 THEN _
  2109.          SECONDS.PER.SESSION! = SECONDS.PER.SESSION! - 60
  2110.       GOTO 33970
  2111. '
  2112. '
  2113. ' * CTRL-LEFT ARROW - DECREASE THE ON-LINE USER'S TIME BY FIVE MINUTES
  2114. '
  2115. '
  2116. 33245 IF SECONDS.PER.SESSION! > 360 THEN _
  2117.          SECONDS.PER.SESSION! = SECONDS.PER.SESSION! - 300
  2118.       GOTO 33970
  2119. '
  2120. '
  2121. ' * RIGHT ARROW - INCREASE THE ON-LINE USER'S TIME BY ONE MINUTE
  2122. '
  2123. '
  2124. 33250 IF SECONDS.PER.SESSION! < 86280 THEN _
  2125.          SECONDS.PER.SESSION! = SECONDS.PER.SESSION! + 60
  2126.       TIME.LOCK.SET = 0
  2127.       GOTO 33970
  2128. '
  2129. '
  2130. ' * CTRL-RIGHT ARROW - INCREASE THE ON-LINE USER'S TIME BY FIVE MINUTES
  2131. '
  2132. '
  2133. 33255 IF SECONDS.PER.SESSION! < 86040 THEN _
  2134.          SECONDS.PER.SESSION! = SECONDS.PER.SESSION! + 300
  2135.       TIME.LOCK.SET = 0
  2136.       GOTO 33970
  2137. '
  2138. '
  2139. ' * UPDATE NODE RECORD WITH LOCAL FUNCTION KEY ACTIVITY
  2140. '
  2141. '
  2142. 33950 IF SNOOP THEN _
  2143.          SUBROUTINE.PARAMETER = 1 : _
  2144.          CALL LINE25
  2145. 33960 IF CONFERENCE.MODE = TRUE THEN _
  2146.          IF LOCAL.USER THEN _
  2147.             GOTO 33970 _
  2148.          ELSE D$ = "Cannot change status during Conference!" : _
  2149.               GOSUB 33210 : _
  2150.               GOTO 33970
  2151.       SUBROUTINE.PARAMETER = 3
  2152.       CALL FILELOCK
  2153.       IF SUBROUTINE.PARAMETER = -1 THEN _
  2154.          GOTO 33970
  2155.       CALL OPENMSG
  2156.       FIELD 1,128 AS MESSAGE.RECORD$
  2157.       GET 1,NODE.RECORD.INDEX
  2158.       MID$(MESSAGE.RECORD$,FIELD.POSITION,2) = STR$(CHANGE.VALUE)
  2159.       CALL SAVEPROF (2)
  2160.       FIELD 1, 128 AS MESSAGE.RECORD$
  2161. 33970 END SUB
  2162. 33990 ' $SUBTITLE: 'PAGEUP - Display user profile to SYSOP'
  2163. ' $PAGE
  2164. '
  2165. '  NAME    -- PAGEUP
  2166. '
  2167. '  INPUTS  --     PARAMETER                    MEANING
  2168. '             ACTIVE.USER.NAME$         CURRENT USER NAME
  2169. '             DOWNLOADS                 # OF FILES DOWNLOADED
  2170. '             EXPIRATION.DATE$          REGISTRATION EXPIRATION
  2171. '             LAST.DATE.TIME.ON.SAVE$   LAST DATE & TIME ON SYSTEM
  2172. '             LAST.MESSAGE.READ         LAST MESSAGE READ BY USER
  2173. '             PASSWORD.SAVE$            USERS PASSWORD
  2174. '             TIMES.LOGGED.ON           TIMES USER HAS LOGGED ON
  2175. '             UPLOADS                   # OF FILES UPLOADED
  2176. '             USER.SECURITY.SAVE        USERS SECURITY LEVEL
  2177. '
  2178. '  OUTPUTS -- MESSAGE.RECORD$
  2179. '
  2180.       SUB PAGEUP STATIC
  2181.       CALL LPRNT (" ",1)
  2182.       CALL LPRNT ("USER NAME : " + ACTIVE.USER.NAME$,1)
  2183.       CALL LPRNT ("SECURITY  :" + STR$(USER.SECURITY.SAVE),1)
  2184.       CALL LPRNT ("PASSWORD  :" + PASSWORD.SAVE$,1)
  2185.       CALL LPRNT ("READ MSG. :" + STR$(LAST.MESSAGE.READ),1)
  2186.       CALL LPRNT ("TIMES ON  :" + STR$(TIMES.LOGGED.ON),1)
  2187.       CALL LPRNT ("LAST ON   :" + LAST.DATE.TIME.ON.SAVE$,1)
  2188.       CALL LPRNT ("DOWNLOADS :" + STR$(DOWNLOADS),1)
  2189.       CALL LPRNT ("UPLOADS   :" + STR$(UPLOADS),1)
  2190.       CALL LPRNT ("DL-BYTES  :" + STR$(DLBYTES!),1)
  2191.       CALL LPRNT ("UL-BYTES  :" + STR$(ULBYTES!),1)
  2192.       IF RESTRICT.BY.DATE THEN _
  2193.          CALL LPRNT ("EXPIRATION: " + EXPIRATION.DATE$,1)
  2194.       CALL LPRNT ("User's Profile",1)
  2195.       END SUB
  2196. 41008 ' $SUBTITLE: 'CHKTREMAIN - Kicks off if no time remaining'
  2197. ' $PAGE
  2198. '
  2199. '  NAME    -- CHKTREMAIN
  2200. '
  2201. '  INPUTS  --     PARAMETER                    MEANING
  2202. '                 TIME.LEFT!
  2203. '  OUTPUTS --     PARAMETER                    MEANING
  2204. '                 TIME.LEFT!      TIME IN MINUTES LEFT IN SESSION
  2205. '                 TCA!            TIME USED IN SECONDS
  2206. '                 SUBROUTINE.PARAMETER   -1 if no time left
  2207. '
  2208.       SUB CHKTREMAIN (TIME.LEFT!) STATIC
  2209.       CALL TIMEREMAIN (TIME.LEFT!)
  2210.       IF BYPASS.TIME.CHECK THEN _
  2211.          EXIT SUB
  2212.       IF TIME.LEFT! < 0.1 THEN _
  2213.          SUBROUTINE.PARAMETER = -1
  2214.       END SUB
  2215. 41010 ' $SUBTITLE: 'TIMEREMAIN - calculates time remaining in a session'
  2216. ' $PAGE
  2217. '
  2218. '  NAME    -- TIMEREMAIN
  2219. '
  2220. '  INPUTS  --     PARAMETER                    MEANING
  2221. '              USER.LOGON.TIME!
  2222. '              SECONDS.PER.SESSION!
  2223. '              BYPASS.TIME.CHECK
  2224. '  OUTPUTS --
  2225. '              TIME.REMAINING!       TIME IN MINUTES LEFT IN SESSION
  2226. '              TCA!                  TIME USED IN SECONDS
  2227. '
  2228.       SUB TIMEREMAIN (TIME.REMAINING!) STATIC
  2229.       TOA! = FRE("A")
  2230.       IF BYPASS.TIME.CHECK THEN _
  2231.          TIME.REMAINING! = SECONDS.PER.SESSION! /60 : _
  2232.          EXIT SUB
  2233.       CALL FINDTIME (TI!)
  2234.       ROLLOVER = FALSE
  2235.       IF TI! > USER.LOGON.TIME! THEN _
  2236.          TCA! = TI! - USER.LOGON.TIME! : _
  2237.          GOTO 41020
  2238.       ROLLOVER = TRUE
  2239.       TCA! = TI! + 86400! - USER.LOGON.TIME!
  2240. 41020 IF TIME.TO.DROP.TO.DOS! = 0 OR _
  2241.          OLD.DAT$ = DATE$ THEN _
  2242.          GOTO 41030
  2243.       IF NOT ROLLOVER AND _
  2244.          USER.LOGON.TIME! + SECONDS.PER.SESSION! => TIME.TO.DROP.TO.DOS! THEN _
  2245.          SECONDS.PER.SESSION! = (TIME.TO.DROP.TO.DOS! - USER.LOGON.TIME!) : _
  2246.          SHORTENED = TRUE
  2247.       IF ROLLOVER AND _
  2248.          USER.LOGON.TIME! + SECONDS.PER.SESSION! - 86400 => TIME.TO.DROP.TO.DOS! THEN _
  2249.          SECONDS.PER.SESSION! = TIME.TO.DROP.TO.DOS! : _
  2250.          SHORTENED = TRUE
  2251.       IF SHORTENED AND NOT TOLD.SHORT THEN _
  2252.          TOLD.SHORT = TRUE : _
  2253.          A$ = "Time shortened for scheduled event" : _
  2254.          CALL RINGCALLER
  2255. 41030 TIME.REMAINING! = (SECONDS.PER.SESSION!-TCA!) / 60
  2256.       TIME.REMAINING! = -(TIME.REMAINING! > 0.0)*TIME.REMAINING!
  2257.       END SUB
  2258. 41032 ' $SUBTITLE: 'DISPLAYTR - Display users time remaining'
  2259. ' $PAGE
  2260. '
  2261. '  NAME    -- DISPLAYTR
  2262. '
  2263. '  INPUTS  --     PARAMETER                    MEANING
  2264. '              TIME.REMAINING!
  2265. '
  2266. '  OUTPUTS --     PARAMETER                    MEANING
  2267. '              TIME.REMAINING! TIME IN MINUTES LEFT IN SESSION
  2268. '
  2269.       SUB DISPLAYTR (TIME.REMAINING!) STATIC
  2270.       CALL TIMEREMAIN (TIME.REMAINING!)
  2271.       CALL QTPUT1 (STR$(INT(TIME.REMAINING!)) + " min left")
  2272.       END SUB
  2273. 41498 ' $SUBTITLE: 'AMORPMTD - give time of day in AM/PM format'
  2274. ' $PAGE
  2275. '
  2276. '  NAME    -- AMORPMTD
  2277. '
  2278. '  INPUTS  --     PARAMETER                    MEANING
  2279. '
  2280. '  OUTPUTS -- CURRENT.DATE$           CURRENT DATE (MM-DD-YY)
  2281. '             TIM$                    CURRENT TIME (I.E. 1:13 PM)
  2282. '             TIME.LOGGEND.ON$        TIME USER LOGGED ON (HH:MM:SS)
  2283. '
  2284. '  PURPOSE -- To set the time and date and
  2285. '             describe the time as "AM" or "PM."
  2286. '
  2287.       SUB AMORPMTD STATIC                                            ' KG061203
  2288. '
  2289. '
  2290. ' *  CALCULATE CURRENT TIME FOR AM OR PM
  2291. '
  2292. '
  2293. 41500 TIME.LOGGED.ON$ = TIME$
  2294.       CURRENT.DATE$ = DATE$
  2295.       CURRENT.DATE$ = LEFT$(CURRENT.DATE$ ,6) + _
  2296.                       RIGHT$(CURRENT.DATE$ ,2)
  2297.       CALL AMORPM                                                    ' KG061203
  2298.       END SUB
  2299.       SUB AMORPM STATIC                                              ' KG061203
  2300. 41510 TIM$ = TIME$
  2301.       IF VAL(MID$(TIM$,1,2)) = 12 THEN _
  2302.          MID$(TIM$,1,2) = RIGHT$(STR$(VAL(MID$(TIM$,1,2))),2) : _
  2303.          TIM$ = LEFT$(TIM$,5) + _
  2304.                 " PM" : _
  2305.          EXIT SUB
  2306.       IF VAL(MID$(TIM$,1,2)) > 11 THEN _
  2307.          MID$(TIM$,1,2) = RIGHT$(STR$(VAL(MID$(TIM$,1,2))-12),2) : _
  2308.          TIM$ = LEFT$(TIM$,5) + _
  2309.                 " PM" : _
  2310.          EXIT SUB
  2311.       TIM$ = LEFT$(TIM$,5) + _
  2312.              " AM"
  2313.       END SUB                                                        ' KG061203
  2314. 42000 ' $SUBTITLE: 'CARRIER - sub to monitor carrier on comm. port'
  2315. ' $PAGE
  2316. '
  2317. '  NAME    -- CARRIER
  2318. '
  2319. '  INPUTS  --     PARAMETER                    MEANING
  2320. '              AUTO.LOGOFF                  -1 if in autologoff request
  2321. '
  2322. '  OUTPUTS --  SUBROUTINE.PARAMETER = 0     CONTINUE
  2323. '              SUBROUTINE.PARAMETER = -1    TERMINATE (NO CARRIER)
  2324. '
  2325. '  PURPOSE --  To test whether should continue in RBBS.  Reasons
  2326. '              NOT to continue are:  autologoff, out of time, or
  2327. '              carrier dropped.
  2328. '
  2329.       SUB CARRIER STATIC
  2330.       IF AUTO.LOGOFF THEN _                                          ' KG061203
  2331.          SUBROUTINE.PARAMETER = -1 : _                               ' KG061203
  2332.          EXIT SUB                                                    ' KG061203
  2333.       CALL CHKCARRIER                                                ' KG061203
  2334.       END SUB                                                        ' KG061203
  2335. 42005 ' $SUBTITLE: 'CHKCARRIER - monitors carrier on comm. port'     ' KG080501
  2336. ' $PAGE
  2337. '
  2338. '  NAME    -- CHKCARRIER
  2339. '
  2340. '  INPUTS  --     PARAMETER                    MEANING
  2341. '              LOCAL.USER = 0               REMOTE USER
  2342. '              LOCAL.USER = -1              LOCAL KEYBOARD USER
  2343. '              MODEM.STATUS.REGISTER        ADDRESS OF THE COMMUNI-
  2344. '                                           CATIONS PORT'S REGISTER
  2345. '              SUBROUTINE.PARAMETER = -9    DON'T WRITE TO CALLERS
  2346. '              SUBROUTINE.PARAMETER = -10   SAME AS -9, BUT DON'T
  2347. '                                           DELAY
  2348. '
  2349. '  OUTPUTS --  SUBROUTINE.PARAMETER = 0     CARRIER STILL PRESENT
  2350. '              SUBROUTINE.PARAMETER = -1    CARRIER NOT PRESENT
  2351. '
  2352. '  PURPOSE --  To test if carrier is present (i.e. the user
  2353. '              is still on line).  Ignores whether in autologoff.
  2354. '
  2355.       SUB CHKCARRIER STATIC                                          ' KG061203
  2356.       IF SUBROUTINE.PARAMETER = -1 THEN _
  2357.          EXIT SUB
  2358.       SPEEDY = SUBROUTINE.PARAMETER
  2359.       SUBROUTINE.PARAMETER = 0
  2360. '
  2361. '
  2362. ' * TEST FOR CARRIER PRESENT (DROP CALLER IF CARRIER NOT PRESENT)
  2363. '
  2364. '
  2365.       IF LOCAL.USER THEN _
  2366.          EXIT SUB
  2367.       IF FOSSIL THEN _
  2368.          CALL FOSSTATUS(COMPORT%,STATUS%) : _
  2369.          STATUS% = STATUS% AND &H0080 : _
  2370.          IF STATUS% = &H0080 THEN _
  2371.             EXIT SUB _
  2372.          ELSE GOTO 42015
  2373. 42010 IF INP(MODEM.STATUS.REGISTER) > 127 THEN _
  2374.          EXIT SUB
  2375. '
  2376. '
  2377. ' * IN CASE USER IS 2400 BAUD, PAUSE A SECOND AND CHECK AGAIN FOR CARRIER
  2378. ' * DETECT.  SOME 2400 BAUD MODEMS TAKE A WHILE TO SYNCHRONIZE THE CARRIER,
  2379. ' * HENCE A THREE-SECOND PAUSE BEFORE CHECKING AGAIN.
  2380. '
  2381. '
  2382. 42015 IF SPEEDY = -10 THEN _
  2383.          GOTO 42020
  2384.       CALL DELAYIT (MODEM.INIT.WAIT.TIME)
  2385.       IF FOSSIL THEN _
  2386.          CALL FOSSTATUS(COMPORT%,STATUS%) : _
  2387.          STATUS% = STATUS% AND &H0080 : _
  2388.          IF STATUS% = &H0080 THEN _
  2389.             EXIT SUB
  2390.       IF INP(MODEM.STATUS.REGISTER) > 127 THEN _
  2391.          EXIT SUB
  2392. 42020 SUBROUTINE.PARAMETER = -1
  2393.       IF SPEEDY < -8 THEN _
  2394.          EXIT SUB
  2395.       IF ALREADY.WRITTEN = -9 THEN _
  2396.          EXIT SUB
  2397.       CALL MODEMPUT (MODEM.GO.OFFHOOK.COMMAND$)
  2398.       CALL DELAYIT (MODEM.COMMAND.DELAY.TIME)
  2399.       MODEM.OFFHOOK = -1
  2400.       ALREADY.WRITTEN = -9
  2401. ' Pe 03/22/89  Auto Log off fix
  2402. IF DOWNLOAD.COMPLETED AND AUTO.END = 1 THEN _
  2403.       CALL UPDTCALR (" Used Auto Logg Off ",1) _
  2404. ELSE _
  2405.       CALL UPDTCALR ("Carrier dropped",1)
  2406.       END SUB
  2407. 43004 ' $SUBTITLE: 'ASKGRAPH -- sub to ask users graphic preference'
  2408. ' $PAGE
  2409. '
  2410. '  NAME    -- ASKGRAPH
  2411. '
  2412. '  INPUTS  --    PARAMETER                    MEANING
  2413. '                UGD$                         USER GRAPHIC DEFAULT
  2414. '
  2415. '  OUTPUTS --
  2416. '
  2417. '  PURPOSE --  To determine users graphics default
  2418. '
  2419.       SUB ASKGRAPH (UGD$) STATIC
  2420.       IF EXPERT.USER THEN _
  2421.          GOTO 43007
  2422. 43006 FILE.NAME$ = HELP$(9)
  2423.       CALL BUFFILE (FILE.NAME$,X)
  2424.       IF SUBROUTINE.PARAMETER = -1 THEN _
  2425.          EXIT SUB
  2426. 43007 CALL QTPUT1 ("GRAPHICS for text files and menus")
  2427.       A$ = "Change from " + MID$("NAC",GR+1,1) + " to N)one, A)scii-IBM, C)olor-IBM, H)elp" + PRESS.ENTER.EXPERT$
  2428.       SUBROUTINE.PARAMETER = 1
  2429.       TURBO.KEY = -TURBO.KEY.USER
  2430.       CALL TGET
  2431.       IF SUBROUTINE.PARAMETER = -1 THEN _
  2432.          EXIT SUB
  2433.       IF Q = 0 THEN _
  2434.          CALL QTPUT1 ("Unchanged") : _
  2435.          EXIT SUB
  2436.       CALL ALLCAPS (B$(1))
  2437.       GR = INSTR("NAC",B$(1))
  2438.       IF GR = 2 AND NOT EIGHT.BIT THEN _
  2439.          CALL QTPUT1 ("Ascii unavailable.  Requires 8 bit") : _
  2440.          GOTO 43007
  2441.       IF GR = 0 THEN _
  2442.          GOTO 43006
  2443.       GR = GR - 1
  2444.       CALL SETUGD (GR,UGD$)
  2445.       CALL GETCOLOR          'Pe color mods
  2446.       END SUB
  2447. '
  2448. 43031 ' $SUBTITLE: 'GRAPHIC - sub to find graphic version of a file'
  2449. ' $PAGE
  2450. '
  2451. '  NAME    -- GRAPHIC
  2452. '
  2453. '  INPUTS  --     PARAMETER                    MEANING
  2454. '                 DEFAULT$          USERS GRAPHIC DEFAULT
  2455. '                 GR                WHETHER GRAPHICS ARE AVAILABLE
  2456. '                 FILNAME$          FILE TO CHECK
  2457. '
  2458. '  OUTPUTS --     FILNAME$          SUBSTITUTES NAME OF GRAPHICS
  2459. '                                   FILE (IF IT EXISTS).
  2460. '
  2461. '  PURPOSE -- Checks whether there is a graphics version of
  2462. '             a file, based on users graphics perference.
  2463. '             Sets file name to graphcis file if it exists,
  2464. '             Otherwise leaves file name intact.  Returns file
  2465. '             name to use.
  2466. '
  2467.       SUB GRAPHICX (DEFAULT$,FILNAME$,FILNUM) STATIC                 ' KG061001
  2468.       OK = FALSE
  2469.       IF GR THEN _
  2470.          CALL BRKFNAME (FILNAME$,DR$,X$,EXTENTION$,TRUE) : _
  2471.          IF LEN(X$) < 8 THEN _
  2472.             DF$ = DR$ + _
  2473.                   X$ + _
  2474.                   DEFAULT$ + _
  2475.                   EXTENTION$ : _
  2476.              CALL FINDITX (DF$,FILNUM) : _                           ' KG061001
  2477.              IF OK THEN _
  2478.                 FILNAME$ = DF$ : _
  2479.                 IF DEFAULT$ = "C" THEN _
  2480.                    LINES.PRINTED = 0
  2481.       IF NOT OK THEN _
  2482.          CALL FINDITX (FILNAME$,FILNUM)                              ' KG061001
  2483.       END SUB
  2484.       SUB GRAPHIC (DEFAULT$,FILNAME$) STATIC                         ' KG061001
  2485.       CALL GRAPHICX (DEFAULT$,FILNAME$,2)                            ' KG061001
  2486.       END SUB
  2487. 43068 ' $SUBTITLE: 'SAVEPROF - subroutine to read a user profile'
  2488. ' $PAGE
  2489. '
  2490. '  NAME    -- SAVEPROF
  2491. '
  2492. '  INPUTS  --     PARAMETER                    MEANING
  2493. '              BPS
  2494. '              EIGHT.BIT
  2495. '              EXIT.TO.DOORS
  2496. '              GR
  2497. '              MESSAGE.RECORD$
  2498. '              NODE.RECORD.INDEX
  2499. '              SYSOP
  2500. '              UPPER.CASE
  2501. '              TIME.LOGGED.ON$
  2502. '              PRIVATE.DOOR
  2503. '              RELIABLE.MODE
  2504. '
  2505. '  OUTPUTS -- NONE
  2506. '
  2507. '  PURPOSE -- Saves a user's options and communications parameters
  2508. '             in the node record when a user exits to a "door" so
  2509. '             that he is in the same status as when he exited.
  2510. '
  2511.       SUB SAVEPROF(IPARM) STATIC
  2512.       ON IPARM GOTO 43070,43080                                      ' KG072501
  2513. 43070 ACTIVE.MESSAGE.FILE$ = ORIG.MESSAGE.FILE$
  2514.       SUBROUTINE.PARAMETER = 3
  2515.       CALL FILELOCK
  2516.       CALL OPENMSG
  2517.       FIELD 1, 128 AS MESSAGE.RECORD$
  2518.       GET 1,NODE.RECORD.INDEX
  2519.       IF GLOBAL.SYSOP THEN _
  2520.          MID$(MESSAGE.RECORD$,1,30) = "SYSOP" + SPACE$(25)
  2521.       MID$(MESSAGE.RECORD$,40,2) = STR$(EXIT.TO.DOORS)
  2522.       MID$(MESSAGE.RECORD$,42,2) = STR$(EIGHT.BIT)
  2523.       MID$(MESSAGE.RECORD$,44,2) = STR$(BPS)
  2524.       MID$(MESSAGE.RECORD$,46,2) = STR$(UPPER.CASE)
  2525.       MID$(MESSAGE.RECORD$,48,5) = MKS$(NUM.DWN.BYTS!) + MID$(STR$(-BATCH.TRANSFER),2)
  2526.       MID$(MESSAGE.RECORD$,53,2) = STR$(GR)
  2527.       MID$(MESSAGE.RECORD$,55,2) = STR$(SYSOP)
  2528.       MID$(MESSAGE.RECORD$,65,3) = CHR$(VAL(LEFT$(TIME.LOGGED.ON$,2))) + _
  2529.                                    CHR$(VAL(MID$(TIME.LOGGED.ON$,4,2))) + _
  2530.                                    CHR$(VAL(MID$(TIME.LOGGED.ON$,7,2)))
  2531.       MID$(MESSAGE.RECORD$,72,2) = STR$(PRIVATE.DOOR)
  2532.       MID$(MESSAGE.RECORD$,74,1) = MID$(STR$(TRANSFER.FUNCTION),2,1)
  2533.       MID$(MESSAGE.RECORD$,75,1) = FT$
  2534.       MID$(MESSAGE.RECORD$,113,2) = MKI$(CINT(TIME.CREDITS!)/60)     ' RH080201
  2535.       MID$(MESSAGE.RECORD$,79,8) = LEFT$(DOORED.TO$+"        ",8)
  2536.       MID$(MESSAGE.RECORD$,91,2) = STR$(RELIABLE.MODE)
  2537.       CALL BRKFNAME (CURRENT.PUI$,A$,B$,Z$,FALSE)
  2538.       MID$(MESSAGE.RECORD$,93,8) = B$ + SPACE$(8 - LEN(B$))
  2539.       MID$(MESSAGE.RECORD$,101,2) = STR$(LOCAL.USER)
  2540.       MID$(MESSAGE.RECORD$,103,2) = STR$(LOCAL.USER.MODE)
  2541.       GRN$ = LEFT$(GRN$,INSTR(GRN$ + " "," ") - 1)
  2542.       MID$(MESSAGE.RECORD$,105,8) = GRN$ + SPACE$(8 - LEN(GRN$))
  2543.       MID$(MESSAGE.RECORD$,115,1) = MID$(STR$(AUTO.LOGOFF),2,1)      ' DA083002
  2544.       MID$(MESSAGE.RECORD$,117,2) = STR$(MENU.INDEX)
  2545.       MID$(MESSAGE.RECORD$,119,2) = LEFT$(DATE$,2)
  2546.       MID$(MESSAGE.RECORD$,121,2) = MID$(DATE$,4,2)
  2547.       MID$(MESSAGE.RECORD$,123,2) = RIGHT$(DATE$,2)
  2548.       MID$(MESSAGE.RECORD$,125,2) = LEFT$(TIME$,2)
  2549.       MID$(MESSAGE.RECORD$,127,2) = MID$(TIME$,4,2)
  2550. 43080 PUT 1,NODE.RECORD.INDEX
  2551.       SUBROUTINE.PARAMETER = 2
  2552.       CALL FILELOCK
  2553.       CALL OPENMSG
  2554.       END SUB
  2555. 44000 ' $SUBTITLE: 'READPROF - subroutine to restore a user profile'
  2556. ' $PAGE
  2557. '
  2558. '  NAME    -- READPROF
  2559. '
  2560. '  INPUTS  --     PARAMETER                    MEANING
  2561. '              NODE.RECORD.INDEX     NODE RECORD TO USE
  2562. '              SYSOP.PASSWORD.1$     SYSOP'S PSEUDONYM 1
  2563. '              SYSOP.PASSWORD.2$     SYSOP'S PSEUDONYM 2
  2564. '
  2565. '  OUTPUTS -- USER'S OPTIONS AND COMMUNICATIONS PARAMETERS
  2566. '             UPON EXITING RBBS-PC TO A "DOOR"
  2567. '
  2568. '  PURPOSE -- Reset a user's options and communications parameters
  2569. '             that were saved in the node record when a user exited
  2570. '             to a "door" so that he is in the same status as when
  2571. '             he exited.
  2572. '
  2573.       SUB READPROF STATIC                                            ' KG072501
  2574.       LOCATE 24,1
  2575.       CALL LPRNT("NODE INDEX" + STR$(NODE.RECORD.INDEX),1)
  2576.       FIELD 1, 128 AS MESSAGE.RECORD$
  2577.       GET 1,NODE.RECORD.INDEX
  2578.       RELIABLE.MODE = VAL(MID$(MESSAGE.RECORD$,91,2))
  2579.       MID$(MESSAGE.RECORD$,40,2) = "00"
  2580.       EIGHT.BIT = VAL(MID$(MESSAGE.RECORD$,42,2))
  2581.       BPS = VAL(MID$(MESSAGE.RECORD$,44,2))
  2582.       CALL COMMINFO
  2583.       BAUD.TEST! = VAL(MID$("      300  450 1200 2400 4800 96001920038400",(-5 * BPS),5)) ' KG090102
  2584.       UPPER.CASE = VAL(MID$(MESSAGE.RECORD$,46,2))
  2585.       NUM.DWN.BYTS! = CVS(MID$(MESSAGE.RECORD$,48,4))
  2586.       BATCH.TRANSFER = (MID$(MESSAGE.RECORD$,52,1) = "1")
  2587.       GR = VAL(MID$(MESSAGE.RECORD$,53,2))
  2588.       HOUR.LOGGED.ON$ = RIGHT$("0"+MID$(STR$(ASC(MID$(MESSAGE.RECORD$,65,1))),2),2)  ' KP061804
  2589.       MIN.LOGGED.ON$  = RIGHT$("0"+MID$(STR$(ASC(MID$(MESSAGE.RECORD$,66,1))),2),2)  ' KP061804
  2590.       SEC.LOGGED.ON$  = RIGHT$("0"+MID$(STR$(ASC(MID$(MESSAGE.RECORD$,67,1))),2),2)  ' KP061804
  2591.       TIME.LOGGED.ON$ = HOUR.LOGGED.ON$ + _                                          ' KP061804
  2592.                         ":" + _                                                      ' KP061804
  2593.                         MIN.LOGGED.ON$ + _                                           ' KP061804
  2594.                         ":" + _                                                      ' KP061804
  2595.                         SEC.LOGGED.ON$                                               ' KP061804
  2596.       TRANSFER.FUNCTION = VAL(MID$(MESSAGE.RECORD$,74,1))
  2597.       FT$ = MID$(MESSAGE.RECORD$,75,1)
  2598.       TIME.CREDITS! = 60*CVI(MID$(MESSAGE.RECORD$,113,2))            ' RH080201
  2599.       DOORED.TO$ = MID$(MESSAGE.RECORD$,79,8)
  2600.       CALL TRIM (DOORED.TO$)
  2601.       IF EXIT.TO.DOORS AND DOORED.TO$ <> "" THEN _
  2602.          CALL OPENWORK (2,DOORS.DEF$) : _
  2603.          IF EC = 0 THEN _
  2604.             CALL READPARMS (A$(),8,1) : _
  2605.             WHILE EC = 0 AND A$(1) <> DOORED.TO$ : _
  2606.                CALL READPARMS (A$(),8,1) : _
  2607.             WEND : _
  2608.             IF A$(1) = DOORED.TO$ THEN _
  2609.                DOOR.SKIPS.PASSWORD = TRUE : _
  2610.                CALL BUFFILE (A$(7),X)
  2611.       EC = 0
  2612.       MENU.INDEX = VAL(MID$(MESSAGE.RECORD$,117,2))
  2613.       CURRENT.PUI$ = MID$(MESSAGE.RECORD$,93,8)
  2614.       CALL REMOVE (CURRENT.PUI$," ")
  2615.       IF CURRENT.PUI$ <> "" THEN _
  2616.          CALL BRKFNAME (MAIN.PUI$,A$,B$,Z$,TRUE) : _
  2617.          CURRENT.PUI$ = A$ + CURRENT.PUI$ + Z$
  2618.       CUSTOM.PUI = (CURRENT.PUI$ <> "")
  2619.       LOCAL.USER = VAL(MID$(MESSAGE.RECORD$,101,2))
  2620.       LOCAL.USER.MODE = VAL(MID$(MESSAGE.RECORD$,103,2))
  2621.       HOME.CONFERENCE$ = MID$(MESSAGE.RECORD$,105,8)
  2622.       AUTO.LOGOFF = (VAL(MID$(MESSAGE.RECORD$,115,1)) <> 0)          ' DA083002
  2623.       CALL TRIM (HOME.CONFERENCE$)
  2624.       IF REQUIRED.RINGS > 0 AND _
  2625.          INSTR(MODEM.INIT.COMMAND$,"S0=255") THEN _
  2626.          COLOR 7,0,0 _
  2627.       ELSE COLOR FG,BG,BORDER
  2628.       IF LOCAL.USER.MODE THEN _
  2629.          GOTO 44003
  2630.       CALL SETBAUD
  2631. 44003 USER.LOGON.TIME! = VAL(HOUR.LOGGED.ON$) * 3600 + _             ' KP061804
  2632.                          VAL(MIN.LOGGED.ON$) * 60 + _                ' KP061804
  2633.                          VAL(SEC.LOGGED.ON$)                         ' KP061804
  2634.       HOUR.LOGGED.ON$ = ""                                           ' KP061804
  2635.       MIN.LOGGED.ON$ = ""                                            ' KP061804
  2636.       SEC.LOGGED.ON$ = ""                                            ' KP061804
  2637.       IF MINUTES.PER.SESSION! < 1 THEN _
  2638.          MINUTES.PER.SESSION! = 3
  2639.       IF NOT EIGHT.BIT THEN _
  2640.          OUT LINE.CONTROL.REGISTER,&H1A
  2641.       IF LEFT$(MESSAGE.RECORD$,7) = "SYSOP  " THEN _
  2642.          ACTIVE.USER.NAME$ = SYSOP.PASSWORD.1$ + " " + SYSOP.PASSWORD.2$ _
  2643.       ELSE FIRST.NAME.END = INSTR(MESSAGE.RECORD$," ") : _
  2644.            LAST.NAME.END = INSTR(FIRST.NAME.END + 1,MESSAGE.RECORD$ + " ","  ") : _
  2645.            FIRST.NAME$ = LEFT$(MESSAGE.RECORD$,FIRST.NAME.END-1) : _
  2646.            LAST.NAME$ = MID$(MESSAGE.RECORD$,FIRST.NAME.END + 1,LAST.NAME.END - (FIRST.NAME.END + 1)) : _
  2647.            ACTIVE.USER.NAME$ = MID$(FIRST.NAME$ + " " + LAST.NAME$,1,31)
  2648.       Z$ = FIRST.NAME$
  2649.       END SUB
  2650. 44020 ' $SUBTITLE: 'COMMINFO - sub for variable of users baud/parity'
  2651. ' $PAGE
  2652. '
  2653. '  NAME    -- COMMINFO
  2654. '
  2655. '  INPUTS  --     PARAMETER                    MEANING
  2656. '                 BPS               BAUD RATE INDICATOR
  2657. '                 EIGHT.BIT           INDICATE FOR N/8/1
  2658. '
  2659. '  OUTPUTS -- BAUD.PARITY$
  2660. '
  2661. '  PURPOSE -- Create a string that shows a users baud rate and parity
  2662. '
  2663.       SUB COMMINFO STATIC
  2664. '
  2665. '
  2666. ' *  DETERMINE BAUD AND PARITY
  2667. '
  2668. '
  2669.   IF RELIABLE.MODE THEN _
  2670.      RELIABLE.MODE$ = "-R," _
  2671.   ELSE RELIABLE.MODE$ = ","
  2672.   BAUD.PARITY$ = MID$("      300  450 1200 2400 4800 96001920038400",(-5 * BPS),5) + _ ' KG090201
  2673.                  " BAUD" + _
  2674.                  RELIABLE.MODE$ + _
  2675.                  MID$("N,8,1E,7,1",6 + 5 * EIGHT.BIT,5)
  2676.   BAUD.TEST! = VAL(BAUD.PARITY$)                                     ' KG090102
  2677.   END SUB
  2678. 50495 ' $SUBTITLE: 'DELAYIT - sub to wait number of seconds specified'
  2679. ' $PAGE
  2680. '
  2681. '  NAME    -- DELAYIT
  2682. '
  2683. '  INPUTS  --     PARAMETER                    MEANING
  2684. '                 DELAY.TIME           NUMBER OF SECONDS TO DELAY
  2685. '                                      (0 TO 3,600)
  2686. '
  2687. '  OUTPUTS -- NONE
  2688. '
  2689. '  PURPOSE -- To wait the number of seconds indicated before
  2690. '             returning control to the calling routine.
  2691. '
  2692.       SUB DELAYIT (DELAY.TIME) STATIC
  2693.       IF DELAY.TIME < 1 THEN _
  2694.          EXIT SUB
  2695.       CALL FINDTIME (DELAY!)
  2696.       DELAY! = DELAY.TIME + DELAY!
  2697.       IF DELAY! < 86400! THEN _
  2698.          GOTO 50520
  2699. 50500 CALL FINDTIME (TI!)
  2700.       IF TI! > DELAY.TIME THEN _  ' IF SECONDS TO DELAY IS PAST
  2701.          GOTO 50500              ' MIDNIGHT WAIT FOR THE CLOCK TO WRAP AROUND
  2702.       DELAY! = DELAY! - 86400!   ' TO PAST MIDNIGHT AND ADJUST THE DELAY
  2703. 50520 CALL FINDTIME (TI!)
  2704.       IF TI! < DELAY! THEN _
  2705.          GOTO 50520
  2706.       END SUB
  2707. 52070 ' $SUBTITLE: 'MODEMPUT - sub to write modem commands to modem'
  2708. ' $PAGE
  2709. '
  2710. '  SUBROUTINE NAME    -- MODEMPUT
  2711. '
  2712. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  2713. '                        STRNG$                    MODEM COMMAND
  2714. '                        COMMANDS.BETWEEN.RINGS    INDICATOR TO WAIT FOR
  2715. '                                                  MODEM TO STOP RINGING
  2716. '                                                  BEFORE ISSUING COMMANDS
  2717. '                        DUMB.MODEM                INDICATOR THAT MODEM WOULD
  2718. '                                                  NOT UNDERSTAND COMMANDS
  2719. '
  2720. '  OUTPUT PARAMETERS  -- NONE
  2721. '
  2722. '  SUBROUTINE PURPOSE -- TO ISSUE MODEM COMMANDS TO THE MODEM
  2723. '
  2724.       SUB MODEMPUT (STRNG$) STATIC
  2725. '
  2726. '
  2727. ' *  SEND MODEM COMMAND
  2728. '
  2729. '
  2730.       IF DUMB.MODEM THEN _
  2731.          EXIT SUB
  2732.       IF NOT COMMANDS.BETWEEN.RINGS OR _
  2733.          NOT (INP(MODEM.STATUS.REGISTER) AND &H40) THEN _
  2734.          GOTO 52080
  2735.       CALL SETABORT (CONNECT.DELAY!,7)
  2736. 52072 IF (INP(MODEM.STATUS.REGISTER) AND &H40) > 0 THEN _
  2737.          CALL FINDTIME (TI!) : _
  2738.          IF TI! > CONNECT.DELAY! OR _
  2739.             (ABS(CONNECT.DELAY! - TI!) > 30 AND _
  2740.              (TI! + 86400 > CONNECT.DELAY!)) THEN _
  2741.             GOTO 52080
  2742.       GOTO 52072
  2743. 52080 CALL DELAYIT (MODEM.COMMAND.DELAY.TIME)
  2744.       CALL COMMPUT (STRNG$)
  2745.       END SUB
  2746. 57001 ' $SUBTITLE: 'DISPCALL - subroutine to display callers file'
  2747. ' $PAGE
  2748. '
  2749. '  NAME    -- DISPCALL
  2750. '
  2751. '  INPUTS  --     PARAMETER           MEANING
  2752. '
  2753. '  OUTPUTS --  (NONE)
  2754. '
  2755. '  PURPOSE -- Displays callers file to sysops and callers
  2756. '
  2757.       SUB DISPCALL STATIC
  2758.       IF CALLERS.FILE.PREFIX$ = "" THEN _
  2759.          EXIT SUB
  2760.       CALL SKIPLINE (1)
  2761.       CALLERS.FILE.INDEX.TEMP! = CALLERS.FILE.INDEX!
  2762.       CLOSE 4
  2763.       IF SHARE.IT THEN _
  2764.          OPEN CALLERS.FILE$ FOR RANDOM SHARED AS #4 LEN=64 _
  2765.       ELSE OPEN "R",4,CALLERS.FILE$,64
  2766.       FIELD 4,64 AS CALLERS.RECORD$
  2767. 57005 IF CALLERS.FILE.INDEX.TEMP! < 1 OR RET THEN _
  2768.          EXIT SUB
  2769. 57010 GET 4,CALLERS.FILE.INDEX.TEMP!
  2770.       A$ = CALLERS.RECORD$
  2771.       IF LEFT$(A$,3) = "   " OR _
  2772.          INSTR(A$,"on at") = 0 THEN _
  2773.          GOTO 57030
  2774. 57025 CALLERS.FILE.INDEX.TEMP! = CALLERS.FILE.INDEX.TEMP! - 1
  2775.       GET 4,CALLERS.FILE.INDEX.TEMP!
  2776.       Z = INSTR(CALLERS.RECORD$,"{")
  2777.       IF Z < 1 OR Z > 15 THEN _
  2778.          Z = 15
  2779.       IF SYSOP OR _
  2780.          LEFT$(A$,3) <> "   " THEN _
  2781.          A$ = A$ + LEFT$(CALLERS.RECORD$,Z - 1)
  2782.       GOSUB 57100
  2783.       IF SYSOP THEN _
  2784.          A$ = MID$(CALLERS.RECORD$,Z) : _
  2785.          GOSUB 57100
  2786.       GOTO 57045
  2787. 57030 IF SYSOP THEN _
  2788.          GOSUB 57100
  2789. 57045 CALLERS.FILE.INDEX.TEMP! = CALLERS.FILE.INDEX.TEMP! -1
  2790.       GOTO 57005
  2791. 57100 IF INSTR(A$,"LOGON DENIED") THEN _
  2792.          IF NOT SYSOP THEN _
  2793.             RETURN
  2794.       CALL QTPUT1 (A$)
  2795.       CALL ASKMORE ("",TRUE,TRUE,X,FALSE)
  2796.       IF NO OR SUBROUTINE.PARAMETER = -1 THEN _
  2797.          EXIT SUB
  2798.       RETURN
  2799.       END SUB
  2800. 58050 ' $SUBTITLE: 'FINDTIME - sub to calculate seconds since midnight'
  2801. ' $PAGE
  2802. '
  2803. '  NAME    -- FINDTIME
  2804. '
  2805. '  INPUTS  --     PARAMETER           MEANING
  2806. '               SECONDS!          VARIABLE TO RETURN RESULTS WITH
  2807. '
  2808. '  OUTPUTS --     SECONDS!          SECONDS SINCE MIDNIGHT
  2809. '
  2810. '  PURPOSE -- To calculate the number of seconds that elapsed since midnight
  2811. '
  2812.       SUB FINDTIME (SECONDS!) STATIC
  2813.       SECONDS! = TIMER
  2814.       END SUB
  2815. 58060 ' $SUBTITLE: 'ALLCAPS - sub to convert string to upper case'
  2816. ' $PAGE
  2817. '
  2818. '  NAME    -- ALLCAPS
  2819. '
  2820. '  INPUTS  --     PARAMETER           MEANING
  2821. '              CONVERT.FIELD$    STRING TO MAKE UPPER CASE
  2822. '
  2823. '  OUTPUTS --  CONVERT.FIELD$    CONVERTED STRINGS
  2824. '
  2825. '  PURPOSE -- Subroutine to convert a string to upper case
  2826. '
  2827.       SUB ALLCAPS (CONVERT.FIELD$) STATIC
  2828.       IF TURBO.RBBS THEN _
  2829.          CALL RBBSULC (CONVERT.FIELD$) : _
  2830.          EXIT SUB
  2831.       FOR Z = 1 TO LEN(CONVERT.FIELD$)
  2832.          IF MID$(CONVERT.FIELD$,Z,1) > "@" THEN _
  2833.             MID$(CONVERT.FIELD$,Z,1) = CHR$(ASC(MID$(CONVERT.FIELD$,Z,1)) AND 223)
  2834.       NEXT
  2835.       END SUB
  2836. 58070 ' $SUBTITLE: 'CHECKTIM - sub to see if time has elasped'
  2837. ' $PAGE
  2838. '
  2839. '  NAME    -- CHECKTIM
  2840. '
  2841. '  INPUTS  --     PARAMETER           MEANING
  2842. '                 MAX.TIME!         NUMBER OF SECONDS PAST MIDNIGHT
  2843. '                                              NOT TO EXCEED
  2844. '
  2845. '  OUTPUTS -- SUBROUTINE.PARAMETER = 1 CURRENT TIME IS LESS THAN
  2846. '                                      MAX.TIME!
  2847. '             SUBROUTINE.PARAMETER = 2 CURRENT TIME IS GREATER THAN
  2848. '                                                 OR EQUAL TO MAX.TIME!
  2849. '
  2850. '  PURPOSE -- Subroutine to check if the current time is greater
  2851. '             than or equal to the time allowed
  2852. '
  2853.       SUB CHECKTIM (MAX.TIME!) STATIC
  2854.       SUBROUTINE.PARAMETER = 1
  2855.       CALL FINDTIME (TI!)
  2856.       IF MAX.TIME! < 86400 AND TI! < MAX.TIME! THEN _
  2857.          EXIT SUB
  2858.       IF MAX.TIME! < 86400 AND TI! => MAX.TIME! THEN _
  2859.          SUBROUTINE.PARAMETER = 2 : _
  2860.          EXIT SUB
  2861.       TEST.TIME! = MAX.TIME! - 86400
  2862.       IF TEST.TIME! - TI! <= 0 THEN _
  2863.          EXIT SUB
  2864.       IF TI! => TEST.TIME! THEN _
  2865.          SUBROUTINE.PARAMETER = 2
  2866.       END SUB
  2867. 58080 ' $SUBTITLE: 'HASHRBBS - sub to determine where to look for user'
  2868. ' $PAGE
  2869. '
  2870. '  NAME    -- HASHRBBS
  2871. '
  2872. '  INPUTS  --     PARAMETER           MEANING
  2873. '               STRNG.TO.HASH$    USER NAME TO LOCATE
  2874. '               MAX.POSITION      MAXIMUM # USERS
  2875. '
  2876. '  OUTPUTS --     PRIME.HASH        WHERE TO LOOK FIRST
  2877. '                SECOND.HASH       LOOK THIS FAR AHEAD
  2878. '
  2879. '  PURPOSE -- Where to look for a user in users file
  2880. '             Look first at prime position, then add
  2881. '             SECOND.HASH until find or find unused record
  2882. '
  2883.       SUB HASHRBBS (STRNG.TO.HASH$,MAX.POSITION,PRIME.HASH,SECOND.HASH) STATIC
  2884.       SECOND.HASH = (ASC(MID$(STRNG.TO.HASH$,2,1)) * 10  + 7) MOD _
  2885.            MAX.POSITION
  2886.       PRIME.HASH = _
  2887.            ((ASC(STRNG.TO.HASH$) * 100  + _
  2888.              ASC(MID$(STRNG.TO.HASH$,(LEN(STRNG.TO.HASH$) / 2) + .1,1)) * _
  2889.              10  + _
  2890.              ASC(RIGHT$(STRNG.TO.HASH$,1))) _
  2891.              MOD MAX.POSITION) + 1
  2892.       END SUB
  2893. 58100 ' $SUBTITLE: 'SETOPTS - sub to set prompts based on user security'
  2894. ' $PAGE
  2895. '
  2896. '  NAME    -- SETOPTS
  2897. '
  2898. '  INPUTS  --     PARAMETER           MEANING
  2899. '                   FIRST             POSITION WHERE START LOOKING
  2900. '                   LAST              POSITION WHERE QUIT LOOKING
  2901. '                 USER.SECURITY.LEVEL SECURITY OF USER
  2902. '
  2903. '  OUTPUTS -- OPTIONS$              LIST OF COMMANDS USER CAN DO
  2904. '
  2905. '  PURPOSE -- String together what commands user can do in a section
  2906. '
  2907.       SUB SETOPTS (OPTIONS$,INVALID.OPTIONS$,FIRST,LAST) STATIC
  2908.       OPTIONS$ = ""
  2909.       INVALID.OPTIONS$ = ""
  2910.       FOR I = FIRST TO LAST
  2911.          IF USER.SECURITY.LEVEL < OPT.SEC(I) THEN _
  2912.             INVALID.OPTIONS$ = INVALID.OPTIONS$ + _
  2913.                                MID$(ALL.OPTS$,I,1) _
  2914.          ELSE IF MID$(ALL.OPTS$,I,1) <> " " THEN _
  2915.                  OPTIONS$ = OPTIONS$ + _
  2916.                             MID$(ALL.OPTS$,I,1)
  2917.       NEXT
  2918.       CALL SRTSTRNG (OPTIONS$)
  2919.       CALL SRTSTRNG (INVALID.OPTIONS$)
  2920.       END SUB
  2921. 58110 ' $SUBTITLE: 'CHKNEWBUL - sub to check whether got new bulletins'
  2922. ' $PAGE
  2923. '
  2924. '  NAME    -- CHKNEWBUL
  2925. '
  2926. '  INPUTS  --     PARAMETER           MEANING
  2927. '                 LAST.ON$          LAST DATE OF LOGON
  2928. '                                   FORMAT MM/DD/YY
  2929. '                 ACTIVE.BULLETINS  # OF BULLETING
  2930. '                 BULLETIN.PREFIX$  FILESPEC FOR BULLETINS
  2931. '
  2932. '  OUTPUTS --     NUM.NEW.BULLETS   NUMBER OF NEW BULLETINS
  2933. '                 NEW.BULLETS$      LIST OF NEW BULLET #'S
  2934. '                 Q                 WHERE LAST BULLETIN STORED
  2935. '                                      IN B$()
  2936. '                 B$()              BULLETINS #'S THAT ARE NEW
  2937. '                                      (2,3,4,...)
  2938. '
  2939. '  PURPOSE -- Checks how many bulletins have system date
  2940. '             at or later than date caller last logged on
  2941. '
  2942.       SUB CHKNEWBUL (LAST.ON$,NUM.NEW.BULLETS,NEW.BULLETS$) STATIC
  2943.       NUM.NEW.BULLETS = 0
  2944.       NEW.BULLETS$ = ":  "
  2945.       BASE.DATE# = VAL(MID$(LAST.ON$,4,2)) + (100 * VAL(MID$(LAST.ON$,1,2))) + _
  2946.                    (10000# * (1900 + VAL(MID$(LAST.ON$,7,2))))
  2947.       CALL FINDIT (BULLETIN.PREFIX$ + ".FCK")
  2948.       X = 0
  2949.       CALL QTPUT ("Checking new bulletins",0)
  2950.       IF OK THEN _
  2951.          WHILE NOT EOF(2) : _
  2952.             LINE INPUT #2,BN$ : _                                    ' TC082701
  2953.             GOSUB 58112 : _
  2954.          WEND _
  2955.       ELSE FOR I = 1 TO ACTIVE.BULLETINS : _
  2956.               BN$ = MID$(STR$(I),2) : _                              ' CS082301
  2957.               GOSUB 58112 : _
  2958.            NEXT
  2959.       Q = NUM.NEW.BULLETS + 1
  2960.       IF NUM.NEW.BULLETS < 1 THEN _
  2961.          NEW.BULLETS$ = ""
  2962.       EXIT SUB
  2963. 58112 X$ = BULLETIN.PREFIX$ + _
  2964.            BN$ + _                                                   ' CS082301
  2965.            CHR$(0)
  2966.       CALL MARKTIME (X)
  2967.       CALL RBBSFIND (X$,IX,YY,MM,DD)
  2968.       IF IX = 0 THEN _
  2969.          FDATE# = DD + (100 * MM) + (10000# * (YY + 1980)) : _
  2970.          IF BASE.DATE# <= FDATE# THEN _
  2971.             NUM.NEW.BULLETS = NUM.NEW.BULLETS + 1 : _
  2972.             B$(NUM.NEW.BULLETS + 1) = BN$ : _                        ' CS082301
  2973.             NEW.BULLETS$ = NEW.BULLETS$ + _
  2974.             " " + _
  2975.             BN$                                                      ' CS082301
  2976.       RETURN
  2977.       END SUB
  2978. 58120 ' $SUBTITLE: 'SRTSTRNG - sub to sort characters in a string'
  2979. ' $PAGE
  2980. '
  2981. '  NAME    -- SRTSTRNG
  2982. '
  2983. '  INPUTS  --     PARAMETER           MEANING
  2984. '                 STRNG$           STRING TO SORT
  2985. '
  2986. '  OUTPUTS --     STRNG$           SORTED STRING
  2987. '
  2988. '  PURPOSE -- Sorts characters in passed string.
  2989. '
  2990.       SUB SRTSTRNG (STRNG$) STATIC
  2991.       S0 = LEN(STRNG$)
  2992.       S1 = S0
  2993.       X$ = "!"
  2994. 58122 S1 = S1\2
  2995.       IF S1 = 0 THEN _
  2996.          EXIT SUB
  2997.       S2 = S0 - S1
  2998.       FOR S3 = 1 TO S2
  2999.          S4 = S3
  3000. 58124    S5 = S4 + S1
  3001.          IF MID$(STRNG$,S4,1) > MID$(STRNG$,S5,1) THEN _
  3002.             LSET X$ = MID$(STRNG$,S4,1) : _
  3003.             MID$(STRNG$,S4,1) = MID$(STRNG$,S5,1) : _
  3004.             MID$(STRNG$,S5,1) = X$ : _
  3005.             S4 = S4 - S1 : _
  3006.             IF S4 > 0 THEN _
  3007.                GOTO 58124
  3008.       NEXT
  3009.       GOTO 58122
  3010.       END SUB
  3011. 58130 ' $SUBTITLE: 'INSCOMMA - sub to format commands in command prompt'
  3012. ' $PAGE
  3013. '
  3014. '  NAME    -- INSCOMMA
  3015. '
  3016. '  INPUTS  --     PARAMETER           MEANING
  3017. '                 STRNG$           STRING TO REPLACE
  3018. '
  3019. '  OUTPUTS --     STRNG$           REPLACED STRING
  3020. '
  3021. '  PURPOSE -- Inserts commands between each letter in STRNG$
  3022. '             and encloses in pointed brackets
  3023. '
  3024.       SUB INSCOMMA (STRNG$) STATIC
  3025.       L = LEN(STRNG$)
  3026.       IF L < 1 THEN _
  3027.          EXIT SUB
  3028.       LSET LINEMES$ = " <" + _
  3029.                       LEFT$(STRNG$,1)
  3030.       FOR K = 2 TO L
  3031.          MID$(LINEMES$,2 * K,2) = "," + _
  3032.                                   MID$(STRNG$,K,1)
  3033.       NEXT
  3034.       STRNG$ = LEFT$(LINEMES$,2 * L + 1) + _
  3035.                ">"
  3036.       END SUB
  3037. 58140 ' $SUBTITLE: 'LOADNEW - subroutine to get latest uploads'
  3038. ' $PAGE
  3039. '
  3040. '  NAME    -- LOADNEW
  3041. '
  3042. '  INPUTS  --     PARAMETER           MEANING
  3043. '               UPLOAD.DIRECTORY$  LIST OF FILES UPLOADED
  3044. '
  3045. '  OUTPUTS --   A$                 LATEST UPLOADS
  3046. '
  3047. '  PURPOSE -- Loads table of most recent number of uploads by date
  3048. '
  3049.       SUB LOADNEW (ARA(2)) STATIC
  3050.       IF FMS.DIRECTORY$ = "" THEN _
  3051.          EXIT SUB
  3052.       PREV.BASE$ = ""
  3053.       IF PREV.LOADNEW$ = FMS.DIRECTORY$ THEN _
  3054.          ARA(1,1) = 0 : _
  3055.          EXIT SUB
  3056.       PREV.LOADNEW$ = FMS.DIRECTORY$
  3057.       CALL OPENFMS (LAST.REC)
  3058.       FIELD 2, 23 AS PRE.DATE$, _
  3059.                 2 AS MM$, _
  3060.                 1 AS FILL1$, _
  3061.                 2 AS DD$, _
  3062.                 1 AS FILL2$, _
  3063.                 2 AS YY$, _
  3064.                 (2 + MAX.DESC.LEN) AS FILL3$, _
  3065.                 3 AS CATEGORY$, _
  3066.                 2 AS FILL4$
  3067.       MAX.RECS = UBOUND(ARA,1)
  3068.       IF MAX.RECS < 1 THEN _
  3069.          MAX.RECS = 1 _
  3070.       ELSE IF MAX.RECS > 23 THEN _
  3071.               MAX.RECS = 23
  3072.       L = 0
  3073.       K = LAST.REC
  3074.       WHILE K > 0 AND L < MAX.RECS
  3075.          GET #2,K
  3076.          IF INSTR("\= ",LEFT$(PRE.DATE$,1)) > 0 THEN _
  3077.             GOTO 58142
  3078.          IF (CAN.DOWNLOAD.FROM.UP OR CATEGORY$ <> DEFAULT.CATEGORY.CODE$) THEN _
  3079.             L = L + 1 : _
  3080.             ARA(L,1) = 372 * (VAL(YY$) - 80) + 31 * VAL(MM$) + VAL(DD$)
  3081.          IF NOT CAN.DOWNLOAD.FROM.UP THEN _
  3082.             X = MIN.SEC.TO.VIEW _
  3083.          ELSE IF CATEGORY$ = "***" THEN _
  3084.                  X = SYSOP.SECURITY.LEVEL _
  3085.               ELSE IF CATEGORY$ = DEFAULT.CATEGORY.CODE$ THEN _
  3086.                       X = MIN.SEC.TO.VIEW _
  3087.                    ELSE X = OPT.SEC(19)
  3088.          ARA(L,2) = X
  3089. 58142    K = K - 1
  3090.       WEND
  3091.       CLOSE 2
  3092.       END SUB
  3093. 58150 ' $SUBTITLE: 'CTNEWFILES - sub to count how many files new'
  3094. ' $PAGE
  3095. '
  3096. '  NAME    -- CTNEWFILES
  3097. '
  3098. '  INPUTS  --     PARAMETER           MEANING
  3099. '                  LAST.ON$          Date of last logon
  3100. '                  UPLDS$            Latest uploads
  3101. '
  3102. '  OUTPUTS --    NUM.NEW.FILES       How many after last logon
  3103. '                RPT.PREFIX$         Set to "At least " if
  3104. '                                    above is a minimum
  3105. '
  3106. '  PURPOSE -- Checks how many files in UPLDS$ were uploaded on or
  3107. '             after date of last logon that the user can download
  3108. '
  3109.       SUB CTNEWFILES (LAST.ON$,UPLDS(2),NUM.USER.FILES,RPT.PREFIX$) STATIC
  3110.       BASE.DATE = 372 * (VAL(MID$(LAST.ON$,7,2)) - 80) + _
  3111.                   31 * (VAL(MID$(LAST.ON$,1,2))) + _
  3112.                   VAL(MID$(LAST.ON$,4,2))
  3113.       NUM.NEW.FILES = 1
  3114.       NUM.USER.FILES = 0
  3115.       WHILE (BASE.DATE <= UPLDS(NUM.NEW.FILES,1) AND _
  3116.                 UPLDS(NUM.NEW.FILES,1) > 0 AND _
  3117.                 NUM.NEW.FILES < UBOUND(UPLDS,1))
  3118.          IF USER.SECURITY.LEVEL => UPLDS(NUM.NEW.FILES,2) THEN _
  3119.             NUM.USER.FILES = NUM.USER.FILES + 1
  3120.          NUM.NEW.FILES = NUM.NEW.FILES + 1
  3121.       WEND
  3122.       IF UPLDS(NUM.NEW.FILES,1) < 1 THEN _
  3123.          NUM.NEW.FILES = NUM.NEW.FILES - 1
  3124.       IF BASE.DATE <= UPLDS(NUM.NEW.FILES,1) THEN _
  3125.          RPT.PREFIX$ = "At least " _
  3126.       ELSE RPT.PREFIX$ = ""
  3127.       END SUB
  3128. 58160 ' $SUBTITLE: 'CTLINES - sub to determine file categories '
  3129. ' $PAGE
  3130. '
  3131. '  NAME    -- CTLINES
  3132. '
  3133. '  INPUTS  -- PARAMETER             MEANING
  3134. '             DIR.CATEGORY.FILE$    NAME OF THE FILE THAT HAS THE
  3135. '                                   NUMBER OF CATEGORIES IN IT.
  3136. '
  3137. '  OUTPUTS -- MAX.ENTRIES           NUMBER OF FILE CATEGORIES
  3138. '
  3139. '  PURPOSE -- Subroutine to count the number of categories that a
  3140. '             file can be classified into.
  3141. '
  3142.       SUB CTLINES (MAX.ENTRIES) STATIC
  3143.       CALL LINESNFIL (DIR.CATEGORY.FILE$,MAX.ENTRIES)
  3144.       MAX.ENTRIES = MAX.ENTRIES + 3
  3145.       IF MAX.ENTRIES < 10 THEN _
  3146.          MAX.ENTRIES = 10
  3147.       END SUB
  3148. 58161 ' $SUBTITLE: 'CTLINES - sub to determine file categories '
  3149. ' $PAGE
  3150. '
  3151. '  NAME    -- LINESNFIL
  3152. '
  3153. '  INPUTS  -- PARAMETER             MEANING
  3154. '             FILNAME$              Name of file to use
  3155. '
  3156. '  OUTPUTS -- LKNT                  Count of # of lines in file
  3157. '
  3158. '  PURPOSE -- Subroutine to count the number of categories that a
  3159. '             file can be classified into.
  3160. '
  3161.       SUB LINESNFIL (FILNAME$,LKNT) STATIC
  3162.       CALL FINDIT (FILNAME$)
  3163.       LKNT = 0
  3164.       IF OK THEN _
  3165.          WHILE NOT EOF(2) : _
  3166.             LKNT = LKNT + 1 : _
  3167.             LINE INPUT #2,A$ : _
  3168.          WEND
  3169.       CLOSE 2
  3170.       END SUB
  3171. 58162 ' $SUBTITLE: 'INITFMS - sub to initialize file management system'
  3172. ' $PAGE
  3173. '
  3174. '  NAME    -- INITFMS
  3175. '
  3176. '  INPUTS  -- PARAMETER             MEANING
  3177. '             FMS.DIRECTORY$
  3178. '
  3179. '  OUTPUTS -- CATEGORY.NAME$()  ELEMENTS 1,2, POSSIBLY MORE
  3180. '             CATEGORY.CODE$()  ELEMENTS 1,2, POSSIBLY MORE
  3181. '             CATEGORY.DESC$()  ELEMENTS 1,2, POSSIBLY MORE
  3182. '             CATEGORY.INDEX    COUNT OF # ELEMENTS IN THE FILE
  3183. '                               MANAGMENT SYSTEM
  3184. '
  3185. '  PURPOSE -- Subroutine to initialize the RBBS-PC File Management System
  3186. '
  3187.      SUB INITFMS (CATEGORY.NAME$(1),CATEGORY.CODE$(1), _
  3188.                    CATEGORY.DESC$(1),CATEGORY.INDEX) STATIC
  3189.       BLNK$ = " "
  3190.       CATEGORY.INDEX = 0
  3191.       IF FMS.DIRECTORY$ <> "" THEN _
  3192.          CATEGORY.INDEX = CATEGORY.INDEX + 1 : _
  3193.          CATN$ = CATEGORY.NAME$(CATEGORY.INDEX) : _
  3194.          CALL BRKFNAME (FMS.DIRECTORY$,DRVPATH$,CATN$,EXTENSION$,FALSE) : _
  3195.          CATEGORY.NAME$(CATEGORY.INDEX) = CATN$ : _
  3196.          CATEGORY.CODE$(CATEGORY.INDEX) = "" : _
  3197.          CATEGORY.DESC$(CATEGORY.INDEX) = "All uploads"_
  3198.       ELSE LIMIT.SEARCH.TO.FMS = FALSE : _
  3199.            EXIT SUB
  3200.       IF LIMIT.SEARCH.TO.FMS OR MASTER.DIRECTORY.NAME$ = MAIN.FMS.DIRECTORY$ THEN _
  3201.          CATEGORY.INDEX = CATEGORY.INDEX + 1 : _
  3202.          CATEGORY.NAME$(CATEGORY.INDEX) = "ALL" : _
  3203.          CATEGORY.CODE$(CATEGORY.INDEX) = "" : _
  3204.          CATEGORY.DESC$(CATEGORY.INDEX) = "All files"
  3205.       CALL FINDIT (DIR.CATEGORY.FILE$)
  3206.       IF NOT OK THEN _
  3207.          EXIT SUB
  3208.       WHILE NOT EOF(2)
  3209.          CALL READPARMS (WORK.ARA$(),3,1)
  3210.          IF EC > 0 THEN _
  3211.             EC = 0 : _
  3212.             CALL PSCRN (DIR.CATEGORY.FILE$+" invalid.  Line" + STR$(CATEGORY.INDEX) + " needs 3 parms") : _
  3213.             CALL DELAYIT (4) _
  3214.          ELSE CATEGORY.INDEX = CATEGORY.INDEX + 1 : _
  3215.               CATEGORY.NAME$(CATEGORY.INDEX) = WORK.ARA$(1) : _
  3216.               CATEGORY.CODE$(CATEGORY.INDEX) = WORK.ARA$(2) : _
  3217.               CATEGORY.DESC$(CATEGORY.INDEX) = WORK.ARA$(3) : _
  3218.               CATR$ = CATEGORY.CODE$(CATEGORY.INDEX) : _
  3219.               CALL REMOVE (CATR$,BLNK$) : _
  3220.               CATEGORY.CODE$(CATEGORY.INDEX) = CATR$
  3221.       WEND
  3222.       CLOSE 2
  3223.       END SUB
  3224. 58165 ' $SUBTITLE: 'DISUPDIR - sub to display upload direcotry'
  3225. ' $PAGE
  3226. '
  3227. '  NAME    -- DISUPDIR
  3228. '
  3229. '  INPUTS  -- PARAMETER             MEANING
  3230. '             PASSED.CATEGORIES$    FILE "CATEGORIES" TO BE INCLUDED IN
  3231. '                                   THE SEARCH.
  3232. '             SEARCH.STRING$        STRING TO SEARCH ON WITHIN THE
  3233. '                                   FILE "CATEGORIES" SELECTED
  3234. '             SEARCH.DATE$          DATE EQUAL TO OR GREATER THAN TO BE
  3235. '                                   SEARCHED FOR WITH THE "CATEGORIES"
  3236. '                                   AND THE STRING TO SEARCH.
  3237. '             DOWNLOAD.FLAG         SET TO RECORD # OF LINE TO BEGIN
  3238. '                                   VIEWING - 0 IF AT END
  3239. '
  3240. '  OUTPUTS -- DOWNLOAD.FLAG         WHENEVER DOWNLOAD REQUESTED, SETS
  3241. '                                   TO NEXT RECORD TO VIEW.  OTHERWISE
  3242. '                                   LEAVES AT ZERO
  3243. '  PURPOSE -- Display the files that meet the criteria selected in
  3244. '             RBBS-PC upload management system on the users screen.
  3245. '
  3246.       SUB DISUPDIR (PASSED.CATEGORIES$,SEARCH.STRING$, _
  3247.                     SEARCH.DATE$,DOWNLOAD.FLAG,ABORT.INDEX) STATIC
  3248.       CALL ALLCAPS (SEARCH.STRING$)
  3249.       BLNK$ = " "
  3250.       STOP.INTERRUPTS = FALSE
  3251.       LAST.INDEX = 0                                                 ' KG081201
  3252.       CATEGORIES$ = "," + _
  3253.                     PASSED.CATEGORIES$ + _
  3254.                     ","
  3255.       CAN.DOWNLOAD = (USER.SECURITY.LEVEL => OPT.SEC(19))
  3256.       GOSUB 58185
  3257.       IF DOWNLOAD.FLAG > 0 THEN _
  3258.          UPLOAD.INDEX = DOWNLOAD.FLAG : _
  3259.          DOWNLOAD.FLAG = 0 : _
  3260.          GOTO 58180
  3261.       EXTRA.PRMPT$ = ",V)iew"
  3262.       IF CAN.DOWNLOAD THEN _
  3263.          IF TURBO.KEY.USER THEN _
  3264.             EXTRA.PRMPT$ = EXTRA.PRMPT$ + ",D)ownload" _
  3265.          ELSE EXTRA.PRMPT$ = EXTRA.PRMPT$ + ", or file(s) to download"
  3266.       MAX.PRINT = PAGE.LENGTH - 1
  3267.       BELOW.MIN.SEC = (USER.SECURITY.LEVEL < MIN.SEC.TO.VIEW)
  3268.       NON.STOP = NON.STOP OR (PAGE.LENGTH < 1)
  3269.       CHECK.POINT = 0
  3270.       WILD.SEARCH = (INSTR(SEARCH.STRING$,"?") > 0) _
  3271.                      OR (INSTR(SEARCH.STRING$,"*") > 0)
  3272. 58168 UPLOAD.INDEX = UPLOAD.INDEX + UPINC
  3273.       IF UPLOAD.INDEX = CUTOFF.REC THEN _
  3274.          GOTO 58182
  3275.       GET #2,UPLOAD.INDEX
  3276.       CHECK.POINT = CHECK.POINT + 1
  3277.       ON INSTR("\* =",LEFT$(PART.TO.PRINT$,1)) GOTO 58168,58171,58170,58169
  3278.       GOTO 58172
  3279. 58169 A = VAL(MID$(PART.TO.PRINT$,34))
  3280.       IF USER.SECURITY.LEVEL < A THEN _
  3281.          LAST.OK = FALSE : _
  3282.          GOTO 58168
  3283.       MID$(PART.TO.PRINT$,1,13) = MID$(PART.TO.PRINT$,2,12) + " "
  3284.       A = LEN(STR$(A))
  3285.       MID$(PART.TO.PRINT$,34) = MID$(PART.TO.PRINT$,34 + A) + SPACE$(A)
  3286.       GOTO 58172
  3287. 58170 IF EXTENDED.OFF THEN _
  3288.          GOTO 58168 _
  3289.       ELSE IF LAST.OK THEN _
  3290.          GOTO 58175 _
  3291.       ELSE IF SEARCH.STRING$ <> "" AND (NOT WILD.SEARCH) AND FAILED.SEARCH THEN _
  3292.               A$ = PART.TO.PRINT$ : _
  3293.               CALL ALLCAPS (A$) : _
  3294.               HIGHLITE.POS = INSTR(A$,SEARCH.STRING$) : _
  3295.               IF HIGHLITE.POS > 0 THEN _
  3296.                  HIGHLITE.REC = UPLOAD.INDEX : _
  3297.                  UPLOAD.INDEX = LAST.FNAME : _
  3298.                  GET 2,UPLOAD.INDEX :_
  3299.                  GOTO 58175 _
  3300.               ELSE GOTO 58168 _
  3301.            ELSE GOTO 58168
  3302. 58171 IF CATEGORY$ = "***" THEN _
  3303.          GOTO 58176 _
  3304.       ELSE KEE$ = "," + CATEGORY$ + "," : _
  3305.            IF INSTR(CATEGORIES$,KEE$) > 0 THEN _
  3306.               GOTO 58176 _
  3307.            ELSE GOTO 58168
  3308. 58172 LAST.OK = FALSE
  3309.       FAILED.SEARCH = FALSE
  3310.       LAST.FNAME = UPLOAD.INDEX
  3311.       IF CATEGORY$ = "***" THEN _
  3312.          IF NOT SYSOP THEN _
  3313.             GOTO 58178
  3314.       IF CATEGORY$ = DEFAULT.CATEGORY.CODE$ THEN _
  3315.          IF BELOW.MIN.SEC THEN _
  3316.             GOTO 58178
  3317. 58173 IF LEN(CATEGORIES$) > 2 THEN _
  3318.          KEE$ = "," + _
  3319.                 CATEGORY$ + _
  3320.                 "," : _
  3321.          CALL REMOVE (KEE$,BLNK$) : _
  3322.          IF INSTR(CATEGORIES$,KEE$) = 0 THEN _
  3323.             GOTO 58178
  3324.       IF SEARCH.STRING$ <> "" THEN _
  3325.          A$ = PART.TO.PRINT$ : _
  3326.          IF WILD.SEARCH THEN _
  3327.             CALL WILDFILE (SEARCH.STRING$,LEFT$(PART.TO.PRINT$,INSTR(PART.TO.PRINT$," ")-1),OK) : _
  3328.             IF OK THEN _
  3329.                GOTO 58175 _
  3330.             ELSE GOTO 58178 _
  3331.          ELSE CALL ALLCAPS (A$) : _
  3332.               HIGHLITE.POS = INSTR(A$,SEARCH.STRING$) : _
  3333.               IF HIGHLITE.POS > 0 THEN _
  3334.                  HIGHLITE.REC = UPLOAD.INDEX _
  3335.               ELSE FAILED.SEARCH = TRUE : _
  3336.                    GOTO 58178
  3337. 58174 IF SEARCH.DATE$ <> "" THEN _
  3338.          KEE$ = MID$(PART.TO.PRINT$,30,2) + _
  3339.                 MID$(PART.TO.PRINT$,24,2) + _
  3340.                 MID$(PART.TO.PRINT$,27,2) : _
  3341.          IF KEE$ < SEARCH.DATE$ THEN _
  3342.             IF DATE.ORDERED.FMS THEN _
  3343.                GOTO 58183 _
  3344.             ELSE GOTO 58168
  3345. '
  3346. '
  3347. ' * Allow the FMS to be both fast and interruptable if a local
  3348. ' * user or there is nothing in the input buffer by using QTPUT.
  3349. '
  3350. '
  3351. 58175 LAST.OK = TRUE
  3352. 58176 A = END.DESC
  3353.       IF LEFT$(PART.TO.PRINT$,5) = "     " THEN _
  3354.          GOTO 58178
  3355.       A$ = PART.TO.PRINT$                                            ' KG081202
  3356.       CALL TRIMTRAIL (A$," ")                                        ' KG081202
  3357.       CALL COLORDIR (A$,"Y")
  3358.       IF UPLOAD.INDEX = HIGHLITE.REC THEN _
  3359.          HIGHLITE.REC = -1 : _
  3360.          HIGHLITE.POS = 0 : _
  3361.          CALL CHKCOLOR (A$,SEARCH.STRING$,"")
  3362. 58177 IF LOCAL.USER THEN _
  3363.          CALL QTPUT1 (A$) : _
  3364.          GOTO 58178
  3365.       CALL EOFCOMM (CHAR%)
  3366.       IF CHAR% = -1 THEN _
  3367.          CALL QTPUT1 (A$) _
  3368.       ELSE SUBROUTINE.PARAMETER = 5 : _
  3369.            CALL TPUT : _
  3370.            IF RET THEN _
  3371.               GOTO 58183
  3372. 58178 IF LINES.PRINTED <= MAX.PRINT AND CHECK.POINT < 1000 THEN _
  3373.          GOTO 58168
  3374.       CALL CHKCARRIER                                                ' KG061203
  3375.       IF SUBROUTINE.PARAMETER = -1 THEN _
  3376.          GOTO 58183
  3377.       CALL TIMEREMAIN (TIME.REMAINING!)
  3378.       IF TIME.REMAINING! < 0.1 THEN _
  3379.          SUBROUTINE.PARAMETER = -1 : _
  3380.          GOTO 58183
  3381.       IF NON.STOP THEN _
  3382.          GOTO 58168
  3383.       IF LINES.PRINTED <= MAX.PRINT THEN _
  3384.          CALL QTPUT1 (EMPHASIZE.OFF$ + "Files checked thru " + MID$(PART.TO.PRINT$,24,8))
  3385. 58180 TURBO.KEY = -TURBO.KEY.USER
  3386.       CALL ASKMORE (EXTRA.PRMPT$, TRUE, FALSE,ABORT.INDEX,FALSE)
  3387.       IF SUBROUTINE.PARAMETER = -1 THEN _
  3388.          GOTO 58183
  3389.       IF NO THEN _
  3390.          GOTO 58183                                                  ' KG082702
  3391.       CALL ALLCAPS (B$(1))
  3392.       IF B$(1) = "V" THEN _
  3393.          LAST.INDEX = Q : _                                          ' KG082702
  3394.          ANS.INDEX = 1 : _                                           ' KG082702
  3395.          CALL GETARC : _
  3396.          A = UPLOAD.INDEX : _
  3397.          GOSUB 58185 : _
  3398.          UPLOAD.INDEX = A : _
  3399.          GOTO 58180
  3400.       IF B$(1) = "D" THEN _
  3401.          A$ = "Download what file(s)" : _
  3402.          CALL POPCSTACK : _                                          ' KG081201
  3403.          IF Q = 0 THEN _
  3404.             GOTO 58180
  3405.       IF LEN(B$(1)) > 2 THEN _
  3406.          IF NOT YES AND CAN.DOWNLOAD THEN _
  3407.             CALL SKIPLINE (1) : _
  3408.             DOWNLOAD.FLAG = UPLOAD.INDEX : _
  3409.             LAST.INDEX = Q : _                                       ' KG081201
  3410.             ANS.INDEX = 1 : _                                        ' KG081201
  3411.             EXIT SUB
  3412.       IF NON.STOP THEN IF UPLOAD.INDEX > 999 THEN _
  3413.          IF (SEARCH.DATE$ = "" OR NOT EXPERT.USER) THEN _
  3414.             A$ = STR$(UPLOAD.INDEX) + _
  3415.                " lines left to search.  Really go non-stop? (Y/[N])" : _
  3416.             NO.ADVANCE = TRUE : _
  3417.             TURBO.KEY = -TURBO.KEY.USER : _
  3418.             SUBROUTINE.PARAMETER = 1 : _
  3419.             CALL TGET : _
  3420.             CALL WIPELINE (79) : _
  3421.             NON.STOP = YES                                           ' KG072301
  3422.       CHECK.POINT = 0
  3423.       GOTO 58168
  3424. 58182 IF CHAINED.DIR$ <> "" THEN _
  3425.          ACTIVE.FMS.DIRECTORY$ = CHAINED.DIR$ : _
  3426.          GOSUB 58185 : _
  3427.          GOTO 58168
  3428. 58183 CLOSE 2
  3429.       NON.STOP = (PAGE.LENGTH < 1)
  3430.       STOP.INTERRUPTS = FALSE
  3431.       A$ = ""
  3432.       EXIT SUB
  3433. 58185 CALL OPENFMS (UPLOAD.INDEX)
  3434.       END.DESC = 33 + MAX.DESC.LEN
  3435.       FIELD 2, END.DESC AS PART.TO.PRINT$, _
  3436.                3 AS CATEGORY$, _
  3437.                2 AS FILLER$
  3438.       PREV.FMS$ = ACTIVE.FMS.DIRECTORY$
  3439.       IF UPINC = -1 THEN _
  3440.          CUTOFF.REC = 0 : _
  3441.          UPLOAD.INDEX = UPLOAD.INDEX + 1 _
  3442.       ELSE CUTOFF.REC = UPLOAD.INDEX + 1 : _
  3443.            UPLOAD.INDEX = 0
  3444.       RETURN
  3445.       END SUB
  3446.